"Return a sequence of the given TYPE and LENGTH, with elements initialized
to :INITIAL-ELEMENT."
(declare (fixnum length))
- (let ((type (specifier-type type)))
+ (let* ((adjusted-type
+ (typecase type
+ (atom (cond
+ ((eq type 'string) '(vector character))
+ ((eq type 'simple-string) '(simple-array character (*)))
+ (t type)))
+ (cons (cond
+ ((eq (car type) 'string) `(vector character ,@(cdr type)))
+ ((eq (car type) 'simple-string)
+ `(simple-array character ,@(when (cdr type)
+ (list (cdr type)))))
+ (t type)))
+ (t type)))
+ (type (specifier-type adjusted-type)))
(cond ((csubtypep type (specifier-type 'list))
(cond
((type= type (specifier-type 'list))
;; 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
- ;; what the upgraded-array-element-type is?" [consider
- ;; (OR STRING BIT-VECTOR)]
- (progn
- (aver (= (length (array-type-dimensions type)) 1))
- (let ((etype (type-specifier
+ (cond
+ (;; is it immediately obvious what the result type is?
+ (typep type 'array-type)
+ (progn
+ (aver (= (length (array-type-dimensions type)) 1))
+ (let* ((etype (type-specifier
(array-type-specialized-element-type type)))
+ (etype (if (eq etype '*) t etype))
(type-length (car (array-type-dimensions type))))
- (unless (or (eq type-length '*)
- (= type-length length))
- (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
- ;; DEFTRANSFORM for MAKE-SEQUENCE. -- CSR,
- ;; 2002-07-22
- (if iep
- (make-array length :element-type etype
- :initial-element initial-element)
- (make-array length :element-type etype))))
- (sequence-type-too-hairy (type-specifier type))))
+ (unless (or (eq type-length '*)
+ (= type-length length))
+ (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
+ ;; DEFTRANSFORM for MAKE-SEQUENCE. -- CSR,
+ ;; 2002-07-22
+ (if iep
+ (make-array length :element-type etype
+ :initial-element initial-element)
+ (make-array length :element-type etype)))))
+ (t (sequence-type-too-hairy (type-specifier type)))))
(t (bad-sequence-type-error (type-specifier type))))))
\f
;;;; SUBSEQ
"Return a new sequence of all the argument sequences concatenated together
which shares no structure with the original argument sequences of the
specified OUTPUT-TYPE-SPEC."
+ (/show0 "full call to CONCATENATE, OUTPUT-TYPE-SPEC=..")
+ (/hexstr output-type-spec)
(let ((type (specifier-type output-type-spec)))
(cond
((csubtypep type (specifier-type 'list))
(frob sequence nil))))
(typecase sequence
(simple-vector (frob2))
- (simple-string (frob2))
+ (simple-base-string (frob2))
(t (vector*-frob sequence))))
(declare (type (or index null) p))
(values f (and p (the index (+ p offset))))))))))
((or (null main) (null sub) (= (the fixnum end1) jndex))
t)
(declare (fixnum jndex))
- (compare-elements (car main) (car sub))))
+ (compare-elements (car sub) (car main))))
(sb!xc:defmacro search-compare-list-vector (main sub)
`(do ((main ,main (cdr main))
(index start1 (1+ index)))
((or (null main) (= index (the fixnum end1))) t)
(declare (fixnum index))
- (compare-elements (car main) (aref ,sub index))))
+ (compare-elements (aref ,sub index) (car main))))
(sb!xc:defmacro search-compare-vector-list (main sub index)
`(do ((sub (nthcdr start1 ,sub) (cdr sub))
(index ,index (1+ index)))
((or (= (the fixnum end1) jndex) (null sub)) t)
(declare (fixnum jndex index))
- (compare-elements (aref ,main index) (car sub))))
+ (compare-elements (car sub) (aref ,main index))))
(sb!xc:defmacro search-compare-vector-vector (main sub index)
`(do ((index ,index (1+ index))
(sub-index start1 (1+ sub-index)))
((= sub-index (the fixnum end1)) t)
(declare (fixnum sub-index index))
- (compare-elements (aref ,main index) (aref ,sub sub-index))))
+ (compare-elements (aref ,sub sub-index) (aref ,main index))))
(sb!xc:defmacro search-compare (main-type main sub index)
(if (eq main-type 'list)