214 |
(let ((t1 (si::normalize-type t1))) |
(let ((t1 (si::normalize-type t1))) |
215 |
(if (integer-typep t1) t1)))) |
(if (integer-typep t1) t1)))) |
216 |
|
|
217 |
|
(defvar *two-stars* '(* *)) |
218 |
|
|
219 |
|
(defun integer-norm-form (form &optional (st *two-stars* stp)) |
220 |
|
(cond ((and (not stp) (atom form)) (integer-norm-form (list form))) |
221 |
|
((and form (or (not st) (atom form))) (error "Bad integer type")) |
222 |
|
(form (cons (car form) (integer-norm-form (cdr form) (if stp (cdr st) st)))) |
223 |
|
(st))) |
224 |
|
|
225 |
(defun integer-type-and (type1 type2) |
(defun integer-type-and (type1 type2) |
226 |
(let ((ct1 (coerce-to-integer-type type1)) |
(let ((ct1 (integer-norm-form (coerce-to-integer-type type1))) |
227 |
(ct2 (coerce-to-integer-type type2))) |
(ct2 (integer-norm-form (coerce-to-integer-type type2)))) |
228 |
(and ct1 ct2 |
(and ct1 ct2 |
229 |
(eq (car ct1) (car ct2)) |
(eq (car ct1) (car ct2)) |
230 |
(let ((b1 (cadr ct1)) |
(let ((b1 (cadr ct1)) |