86 |
`(array ,element-type (,size))) |
`(array ,element-type (,size))) |
87 |
(deftype string (&optional size) |
(deftype string (&optional size) |
88 |
`(vector string-char ,size)) |
`(vector string-char ,size)) |
89 |
|
(deftype base-string (&optional size) |
90 |
|
`(vector base-char ,size)) |
91 |
(deftype bit-vector (&optional size) |
(deftype bit-vector (&optional size) |
92 |
`(vector bit ,size)) |
`(vector bit ,size)) |
93 |
|
|
95 |
`(simple-array t (,size))) |
`(simple-array t (,size))) |
96 |
(deftype simple-string (&optional size) |
(deftype simple-string (&optional size) |
97 |
`(simple-array string-char (,size))) |
`(simple-array string-char (,size))) |
98 |
|
(deftype simple-base-string (&optional size) |
99 |
|
`(simple-array base-char (,size))) |
100 |
(deftype simple-bit-vector (&optional size) |
(deftype simple-bit-vector (&optional size) |
101 |
`(simple-array bit (,size))) |
`(simple-array bit (,size))) |
102 |
|
|
186 |
(typep (imagpart object) (car i)))) |
(typep (imagpart object) (car i)))) |
187 |
)) |
)) |
188 |
(sequence (or (listp object) (vectorp object))) |
(sequence (or (listp object) (vectorp object))) |
189 |
(string |
((base-string string) ;FIXME |
190 |
(and (stringp object) |
(and (stringp object) |
191 |
(or (null i) (match-dimensions (array-dimensions object) i)))) |
(or (null i) (match-dimensions (array-dimensions object) i)))) |
192 |
(bit-vector |
(bit-vector |
193 |
(and (bit-vector-p object) |
(and (bit-vector-p object) |
194 |
(or (null i) (match-dimensions (array-dimensions object) i)))) |
(or (null i) (match-dimensions (array-dimensions object) i)))) |
195 |
(simple-string |
((simple-base-string simple-string) ;FIXME |
196 |
(and (simple-string-p object) |
(and (simple-string-p object) |
197 |
(or (null i) (match-dimensions (array-dimensions object) i)))) |
(or (null i) (match-dimensions (array-dimensions object) i)))) |
198 |
(simple-bit-vector |
(simple-bit-vector |
324 |
(cond ((member t1 '(null cons)) (values t t)) |
(cond ((member t1 '(null cons)) (values t t)) |
325 |
(t (values nil ntp1)))) |
(t (values nil ntp1)))) |
326 |
((eq t2 'sequence) |
((eq t2 'sequence) |
327 |
(cond ((member t1 '(null cons list base-string simple-base-string)) |
(cond ((member t1 '(null cons list)) |
328 |
(values t t)) |
(values t t)) |
329 |
((or (eq t1 'simple-array) (eq t1 'array)) |
((or (eq t1 'simple-array) (eq t1 'array)) |
330 |
(if (and (cdr i1) (consp (cadr i1)) (null (cdadr i1))) |
(if (and (cdr i1) (consp (cadr i1)) (null (cdadr i1))) |
515 |
(if (member t2 '(base-char string-char character)) |
(if (member t2 '(base-char string-char character)) |
516 |
(values t t) |
(values t t) |
517 |
(values nil ntp2))) |
(values nil ntp2))) |
|
(base-string |
|
|
(if (member t2 '(string vector array sequence)) |
|
|
(values t t) |
|
|
(values nil ntp2))) |
|
518 |
(base-char |
(base-char |
519 |
(if (member t2 '(character string-char)) |
(if (member t2 '(character string-char)) |
520 |
(values t t) |
(values t t) |
523 |
(if (member t2 '(character string-char)) |
(if (member t2 '(character string-char)) |
524 |
(values t t) |
(values t t) |
525 |
(values nil ntp2))) |
(values nil ntp2))) |
|
(simple-base-string |
|
|
(if (member t2 '(string simple-string base-string vector |
|
|
simple-vector simple-array array sequence)) |
|
|
(values t t) |
|
|
(values nil ntp2))) |
|
526 |
(string-char |
(string-char |
527 |
(if (eq t2 'character) |
(if (eq t2 'character) |
528 |
(values t t) |
(values t t) |
561 |
(unless (or (endp i2) (eq (car i2) '*)) |
(unless (or (endp i2) (eq (car i2) '*)) |
562 |
(return-from subtypep (values nil t))) |
(return-from subtypep (values nil t))) |
563 |
(unless (or (endp i2) (eq (car i2) '*)) |
(unless (or (endp i2) (eq (car i2) '*)) |
564 |
(unless (equal (car i1) (car i2)) |
(unless (or (equal (car i1) (car i2)) |
565 |
|
; FIXME |
566 |
|
(and (eq (car i1) 'base-char) |
567 |
|
(eq (car i2) 'string-char))) |
568 |
;; Unless the element type matches, |
;; Unless the element type matches, |
569 |
;; return NIL T. |
;; return NIL T. |
570 |
;; Is this too strict? |
;; Is this too strict? |
584 |
(unless (or (endp i2) (eq (car i2) '*)) |
(unless (or (endp i2) (eq (car i2) '*)) |
585 |
(return-from subtypep (values nil t))) |
(return-from subtypep (values nil t))) |
586 |
(unless (or (endp i2) (eq (car i2) '*)) |
(unless (or (endp i2) (eq (car i2) '*)) |
587 |
(unless (equal (car i1) (car i2)) |
(unless (or (equal (car i1) (car i2)) |
588 |
|
; FIXME |
589 |
|
(and (eq (car i1) 'base-char) |
590 |
|
(eq (car i2) 'string-char))) |
591 |
(return-from subtypep |
(return-from subtypep |
592 |
(values nil t))))) |
(values nil t))))) |
593 |
(when (or (endp (cdr i1)) (eq (cadr i1) '*)) |
(when (or (endp (cdr i1)) (eq (cadr i1) '*)) |