178 |
(specific-error :too-few-arguments "Symbol type specifiers must be supplied")) |
(specific-error :too-few-arguments "Symbol type specifiers must be supplied")) |
179 |
`(let ((,p (cons t (if (atom ,plist) (list ,plist) ,plist))) (,q nil) (,l nil) |
`(let ((,p (cons t (if (atom ,plist) (list ,plist) ,plist))) (,q nil) (,l nil) |
180 |
(,i -1) (,x 0) (,y 0)) |
(,i -1) (,x 0) (,y 0)) |
181 |
(labels ((,name () |
(flet ((,name () |
182 |
(when (null (setq ,l (cdr ,l))) |
(tagbody ,name |
183 |
(when (eql (incf ,i) (+ ,x ,y)) |
(when (null (setq ,l (cdr ,l))) |
184 |
(when (null (setq ,q (cdr ,q))) |
(when (eql (incf ,i) (+ ,x ,y)) |
185 |
(when (null (setq ,p (cdr ,p))) |
(when (null (setq ,q (cdr ,q))) |
186 |
(return-from ,name nil)) |
(when (null (setq ,p (cdr ,p))) |
187 |
(rplaca ,p (coerce-to-package (car ,p))) |
(return-from ,name nil)) |
188 |
(setq ,q (list |
(rplaca ,p (coerce-to-package (car ,p))) |
189 |
(si::coerce-to-package (car ,p)))) |
(setq ,q (list |
190 |
(when (member :inherited (list ,@symbol-types)) |
(si::coerce-to-package (car ,p)))) |
191 |
(rplacd ,q (package-use-list (car ,q))))) |
(when (member :inherited (list ,@symbol-types)) |
192 |
(multiple-value-setq (,y ,x) (si::package-size (car ,q))) |
(rplacd ,q (package-use-list (car ,q))))) |
193 |
(when (or (not (member :internal (list ,@symbol-types))) |
(multiple-value-setq (,y ,x) (si::package-size (car ,q))) |
194 |
(not (eq (car ,p) (car ,q)))) |
(when (or (not (member :internal (list ,@symbol-types))) |
195 |
(setq ,x 0)) |
(not (eq (car ,p) (car ,q)))) |
196 |
(when (and (not (member :external (list ,@symbol-types))) |
(setq ,x 0)) |
197 |
(eq (car ,p) (car ,q))) |
(when (and (not (member :external (list ,@symbol-types))) |
198 |
(setq ,y 0)) |
(eq (car ,p) (car ,q))) |
199 |
(when (zerop (+ ,x ,y)) |
(setq ,y 0)) |
200 |
(setq ,i -1) |
(when (zerop (+ ,x ,y)) |
201 |
(return-from ,name (,name))) |
(setq ,i -1) |
202 |
(setq ,i 0)) |
(go ,name)) |
203 |
(setq ,l (if (< ,i ,x) |
(setq ,i 0)) |
204 |
(si::package-internal (car ,q) ,i) |
(setq ,l (if (< ,i ,x) |
205 |
(si::package-external (car ,q) (- ,i ,x))))) |
(si::package-internal (car ,q) ,i) |
206 |
(when (null ,l) |
(si::package-external (car ,q) (- ,i ,x))))) |
207 |
(return-from ,name (,name))) |
(when (null ,l) |
208 |
(multiple-value-setq (,dum ,access) |
(go ,name)) |
209 |
(find-symbol |
(multiple-value-setq (,dum ,access) |
210 |
(symbol-name (car ,l)) (car ,p))) |
(find-symbol |
211 |
(when (and (not (eq ,access :inherited)) |
(symbol-name (car ,l)) (car ,p))) |
212 |
(not (eq (car ,p) (car ,q)))) |
(when (and (not (eq ,access :inherited)) |
213 |
(return-from ,name (,name))) |
(not (eq (car ,p) (car ,q)))) |
214 |
(values 't (car ,l) ,access (car ,p)))) |
(go ,name))) |
215 |
(declare (fixnum ,x ,y)) |
(values 't (car ,l) ,access (car ,p)))) |
216 |
,@declaration |
(declare (fixnum ,x ,y)) |
217 |
,@body)))) |
,@declaration |
218 |
|
,@body)))) |
219 |
|
|