80 |
(boolean (or (eq object 't) (eq object 'nil))) |
(boolean (or (eq object 't) (eq object 'nil))) |
81 |
(bignum (member (type-of-c object) '(bignum non-negative-bignum negative-bignum))) |
(bignum (member (type-of-c object) '(bignum non-negative-bignum negative-bignum))) |
82 |
(ratio (eq (type-of-c object) 'ratio)) |
(ratio (eq (type-of-c object) 'ratio)) |
83 |
((base-char string-char) |
((base-char) (characterp object)) |
|
(and (characterp object) (string-char-p object))) |
|
84 |
(integer |
(integer |
85 |
(and (integerp object) (in-interval-p object i))) |
(and (integerp object) (in-interval-p object i))) |
86 |
(rational |
(rational |
184 |
(match-dimensions (cdr dim) (cdr pat)))))) |
(match-dimensions (cdr dim) (cdr pat)))))) |
185 |
|
|
186 |
|
|
187 |
|
(defun subtypep1 (t1 t2) |
188 |
|
(or (not t1) (eq t2 t) |
189 |
|
(not (car (resolve-type `(and ,t1 ,(negate t2))))))) |
190 |
|
|
191 |
(defun subtypep (t1 t2 &optional env) |
(defun subtypep (t1 t2 &optional env) |
192 |
(declare (ignore env) (optimize (safety 1))) |
(declare (ignore env) (optimize (safety 1))) |
320 |
(deftype unsigned-short ()`(unsigned-byte ,short-length)) |
(deftype unsigned-short ()`(unsigned-byte ,short-length)) |
321 |
(deftype short ()`(signed-short)) |
(deftype short ()`(signed-short)) |
322 |
|
|
323 |
|
(deftype non-negative-int () `(non-negative-byte ,int-length)) |
324 |
|
(deftype negative-int () `(negative-byte ,int-length)) |
325 |
|
(deftype signed-int ()`(signed-byte ,int-length)) |
326 |
|
(deftype unsigned-int ()`(unsigned-byte ,int-length)) |
327 |
|
(deftype int ()`(signed-int)) |
328 |
|
|
329 |
(deftype non-negative-fixnum () `(non-negative-byte ,fixnum-length)) |
(deftype non-negative-fixnum () `(non-negative-byte ,fixnum-length)) |
330 |
(deftype negative-fixnum () `(negative-byte ,fixnum-length)) |
(deftype negative-fixnum () `(negative-byte ,fixnum-length)) |
331 |
(deftype signed-fixnum ()`(signed-byte ,fixnum-length)) |
(deftype signed-fixnum ()`(signed-byte ,fixnum-length)) |
342 |
(deftype vector (&optional element-type size) |
(deftype vector (&optional element-type size) |
343 |
`(array ,element-type (,size))) |
`(array ,element-type (,size))) |
344 |
(deftype string (&optional size) |
(deftype string (&optional size) |
345 |
`(array string-char (,size))) |
`(array character (,size))) |
346 |
(deftype base-string (&optional size) |
(deftype base-string (&optional size) |
347 |
`(array base-char (,size))) |
`(array base-char (,size))) |
348 |
(deftype bit-vector (&optional size) |
(deftype bit-vector (&optional size) |
351 |
(deftype simple-vector (&optional size) |
(deftype simple-vector (&optional size) |
352 |
`(array t (,size))) |
`(array t (,size))) |
353 |
(deftype simple-string (&optional size) |
(deftype simple-string (&optional size) |
354 |
`(array string-char (,size))) |
`(array character (,size))) |
355 |
(deftype simple-base-string (&optional size) |
(deftype simple-base-string (&optional size) |
356 |
`(array base-char (,size))) |
`(array base-char (,size))) |
357 |
(deftype simple-bit-vector (&optional size) |
(deftype simple-bit-vector (&optional size) |
369 |
(deftype extended-char () nil) |
(deftype extended-char () nil) |
370 |
(deftype base-char () `(or standard-char non-standard-base-char)) |
(deftype base-char () `(or standard-char non-standard-base-char)) |
371 |
(deftype character () `(or base-char extended-char)) |
(deftype character () `(or base-char extended-char)) |
|
(deftype string-char () `character) |
|
372 |
|
|
373 |
(deftype stream () `(or broadcast-stream concatenated-stream echo-stream |
(deftype stream () `(or broadcast-stream concatenated-stream echo-stream |
374 |
file-stream string-stream synonym-stream two-way-stream)) |
file-stream string-stream synonym-stream two-way-stream)) |
450 |
(non-keyword-symbol . non-keyword-symbol-p) |
(non-keyword-symbol . non-keyword-symbol-p) |
451 |
(standard-char . standard-char-p) |
(standard-char . standard-char-p) |
452 |
(non-standard-base-char . non-standard-base-char-p) |
(non-standard-base-char . non-standard-base-char-p) |
|
(string-char . string-char-p);;FIXME |
|
453 |
(interpreted-function . interpreted-function-p) |
(interpreted-function . interpreted-function-p) |
454 |
(atom . atom) |
(atom . atom) |
455 |
(cons . consp) |
(cons . consp) |
490 |
|
|
491 |
|
|
492 |
(defconstant +range-types+ `(integer ratio short-float long-float)) |
(defconstant +range-types+ `(integer ratio short-float long-float)) |
493 |
(defconstant +array-types+ '(nil character bit ;FIXME try to live with unsigned alone if can work out the C casting |
|
494 |
non-negative-char signed-char unsigned-char |
(defconstant +array-types+ (si::aelttype-list)) |
495 |
non-negative-short signed-short unsigned-short |
(defconstant +array-types-with-nil-for-ansi+ (append '(nil) +array-types+)) |
|
non-negative-fixnum fixnum |
|
|
short-float long-float t)) |
|
496 |
|
|
497 |
(defconstant +known-types+ (append +range-types+ |
(defconstant +known-types+ (append +range-types+ |
498 |
(mapcar (lambda (x) `(complex ,x)) +range-types+) |
(mapcar (lambda (x) `(complex ,x)) +range-types+) |
499 |
+singleton-types+ |
+singleton-types+ |
500 |
(mapcar (lambda (x) `(array ,x)) +array-types+))) |
(mapcar (lambda (x) `(array ,x)) +array-types-with-nil-for-ansi+))) |
501 |
|
|
502 |
(defconstant +array-type-alist+ (mapcar (lambda (x) (cons x (intern (string-concatenate "ARRAY-" (string x))))) |
(defconstant +array-type-alist+ (mapcar (lambda (x) (cons x (intern (string-concatenate "ARRAY-" (string x))))) |
503 |
+array-types+)) |
+array-types-with-nil-for-ansi+)) |
504 |
(defconstant +complex-type-alist+ (mapcar (lambda (x) (cons x (intern (string-concatenate "COMPLEX-" (string x))))) |
(defconstant +complex-type-alist+ (mapcar (lambda (x) (cons x (intern (string-concatenate "COMPLEX-" (string x))))) |
505 |
+range-types+)) |
+range-types+)) |
506 |
|
|
794 |
|
|
795 |
(defun elgt (x y) |
(defun elgt (x y) |
796 |
(cond ((or (eq (car x) '*) (eq (cdr y) '*)) nil) |
(cond ((or (eq (car x) '*) (eq (cdr y) '*)) nil) |
797 |
|
((and (integerp (car x)) (integerp (cdr y))) (> (car x) (1+ (cdr y)))) |
798 |
|
((and (integerp (range-num (car x))) |
799 |
|
(integerp (range-num (cdr y)))) (>= (range-num (car x)) (1+ (range-num (cdr y))))) |
800 |
((and (numberp (car x)) (numberp (cdr y))) (> (car x) (cdr y))) |
((and (numberp (car x)) (numberp (cdr y))) (> (car x) (cdr y))) |
801 |
((>= (range-num (car x)) (range-num (cdr y)))))) |
((>= (range-num (car x)) (range-num (cdr y)))))) |
802 |
|
|
895 |
;; ARRAY TYPES |
;; ARRAY TYPES |
896 |
|
|
897 |
(defun array-load (ntp type) |
(defun array-load (ntp type) |
898 |
(let* ((z (if (eq (cadr type) 'string-char) 'character (cadr type)));FIXME |
(let* ((z (cadr type)) |
899 |
(z (if (eq z '*) z (car (member z +array-types+))))) |
(z (if (eq z '*) z (car (member z +array-types-with-nil-for-ansi+))))) |
900 |
(unless (or z (not (cadr type))) (error "Bad array type ~a~%" (cadr type))) |
(unless (or z (not (cadr type))) (error "Bad array type ~a~%" (cadr type))) |
901 |
(let* ((dim (caddr type)) |
(let* ((dim (caddr type)) |
902 |
(dim (cond ((eq dim '*) t) |
(dim (cond ((eq dim '*) t) |
939 |
(not (negate (cadr x)))))) |
(not (negate (cadr x)))))) |
940 |
|
|
941 |
(defun array-recon (x) |
(defun array-recon (x) |
942 |
`(array ,(car (rassoc (car x) +array-type-alist+)) ,(cadr x))) |
`(array ,(car (rassoc (car x) +array-type-alist+)) ,(cond ((eq (cadr x) t) '*) ((atom (cadr x)) (cadr x)) ((mapcar (lambda (x) (if (eq x t) '* x)) (cadr x)))))) |
943 |
|
|
944 |
;; STRUCTURES |
;; STRUCTURES |
945 |
|
|