263 |
|
|
264 |
;;FIXME -- centralize subtypep, normalzie-type, type>=, type-and. |
;;FIXME -- centralize subtypep, normalzie-type, type>=, type-and. |
265 |
;;Consider traversing a static tree. CM 20050106 |
;;Consider traversing a static tree. CM 20050106 |
266 |
(defun type-and (type1 type2) |
(defun type-and (type1 type2 &aux tem) |
267 |
|
|
268 |
(let ((nt1 (si::normalize-type type1))) |
(let ((nt1 (si::normalize-type type1))) |
269 |
(unless (and (not (array-wd type1)) (equal nt1 (if (symbolp type1) (list type1) type1))) |
(unless (and (not (array-wd type1)) (equal nt1 (if (symbolp type1) (list type1) type1))) |
289 |
((eq type2 '*) type1) |
((eq type2 '*) type1) |
290 |
((si::memq type1 '(t object)) type2) |
((si::memq type1 '(t object)) type2) |
291 |
((si::memq type2 '(t object)) type1) |
((si::memq type2 '(t object)) type1) |
292 |
|
((setq tem (car (si::resolve-type `(and ,type1 ,type2))));FIXME |
293 |
|
(let ((ntem (si::normalize-type tem))) |
294 |
|
(cond ((equal ntem type1) type1) |
295 |
|
((equal ntem type2) type2) |
296 |
|
(tem)))) |
297 |
((or (integer-typep type1) (integer-typep type2)) |
((or (integer-typep type1) (integer-typep type2)) |
298 |
; (integer-type-and type1 type2))FIXME |
(integer-type-and type1 type2));FIXME |
|
(si::resolve-type `(and ,type1 ,type2))) |
|
299 |
((and (array-tp type1) (array-tp type2)) |
((and (array-tp type1) (array-tp type2)) |
300 |
(cond |
(cond |
301 |
((eq (car type1) (car type2)) |
((eq (car type1) (car type2)) |
359 |
)))) |
)))) |
360 |
|
|
361 |
(defun type>= (type1 type2) |
(defun type>= (type1 type2) |
362 |
(equal (type-and type1 type2) type2)) |
(eq (type-and type1 type2) type2)) |
363 |
|
|
364 |
(defun reset-info-type (info) |
(defun reset-info-type (info) |
365 |
(if (info-type info) |
(if (info-type info) |