132 |
(defun type-and (type1 type2) |
(defun type-and (type1 type2) |
133 |
|
|
134 |
(cond ((equal type1 type2) type1) |
(cond ((equal type1 type2) type1) |
135 |
|
((and (consp type2) (eq (car type2) 'values)) |
136 |
|
(if (and (consp type1) (eq (car type1) 'values)) |
137 |
|
(let ((r (list 'values))) |
138 |
|
(do ((t1 (cdr type1) (cdr t1)) |
139 |
|
(t2 (cdr type2) (cdr t2))) |
140 |
|
((not (and (consp t1) (consp t2))) (nreverse r)) |
141 |
|
(push (type-and (car t1) (car t2)) r))) |
142 |
|
(type-and type1 (second type2)))) |
143 |
|
((and (consp type1) (eq (car type1) 'values)) |
144 |
|
(type-and (second type1) type2)) |
145 |
((eq type1 t) type2) |
((eq type1 t) type2) |
146 |
((eq type1 '*) type2) |
((eq type1 '*) type2) |
147 |
((eq type1 'object) type2) |
((eq type1 'object) type2) |
148 |
((eq type2 'object) type1) |
((eq type2 'object) type1) |
149 |
((eq type2 t) type1) |
((eq type2 t) type1) |
150 |
((eq type2 '*) type1) |
((eq type2 '*) type1) |
|
((and (consp type2) (eq (car type2) 'values)) |
|
|
(type-and type1 (second type2))) |
|
151 |
((consp type1) |
((consp type1) |
152 |
(case (car type1) |
(case (car type1) |
153 |
(array |
(array |
162 |
(if (and (consp type2) (eq (car type2) 'array) |
(if (and (consp type2) (eq (car type2) 'array) |
163 |
(eq (cadr type1) (cadr type2))) |
(eq (cadr type1) (cadr type2))) |
164 |
type1 nil)) |
type1 nil)) |
|
(values (type-and (second type1) type2)) |
|
165 |
(t nil))) |
(t nil))) |
166 |
(t (case type1 |
(t (case type1 |
167 |
(string |
(string |