49 |
;;; Check if THING is an object of the type TYPE. |
;;; Check if THING is an object of the type TYPE. |
50 |
;;; Depends on the implementation of TYPE-OF. |
;;; Depends on the implementation of TYPE-OF. |
51 |
(defun object-type (thing) |
(defun object-type (thing) |
52 |
(let ((type (type-of thing))) |
(let* ((type (type-of thing))) |
53 |
(case type |
(cond ((type>= 'integer type) `(integer ,thing ,thing)) |
54 |
((fixnum bignum) `(integer ,thing ,thing)) |
((eq type 'cons) `(cons ,(object-type (car thing)) ,(if (cdr thing) (object-type (cdr thing)) 'null))) |
55 |
((short-float long-float symbol null boolean) type) |
((eq type 'keyword) 'symbol) |
56 |
(cons `(cons ,(object-type (car thing)) ,(if (cdr thing) (object-type (cdr thing)) 'null))) |
((type>= 'character type) 'character) |
57 |
(keyword 'symbol) |
(type)))) |
|
((standard-char character) 'character) |
|
|
((string bit-vector) type) |
|
|
(vector (list 'vector (array-element-type thing))) |
|
|
(array (list 'array (array-element-type thing))) |
|
|
(t t)))) ; 'unknown ;; I can't see any use of this |
|
58 |
|
|
59 |
(defvar *norm-tp-hash* (make-hash-table :test 'equal)) |
(defvar *norm-tp-hash* (make-hash-table :test 'equal)) |
60 |
(defvar *and-tp-hash* (make-hash-table :test 'equal)) |
(defvar *and-tp-hash* (make-hash-table :test 'equal)) |