- such that successive invocations of (MNAME) will return the symbols,
- one by one, from the packages in PACKAGE-LIST. SYMBOL-TYPES may be
- any of :INHERITED :EXTERNAL :INTERNAL."
- (let* ((packages (gensym))
- (these-packages (gensym))
- (ordered-types (let ((res nil))
- (dolist (kind '(:inherited :external :internal)
- res)
- (when (member kind symbol-types)
- (push kind res))))) ; Order SYMBOL-TYPES.
- (counter (gensym))
- (kind (gensym))
- (hash-vector (gensym))
- (vector (gensym))
- (package-use-list (gensym))
- (init-macro (gensym))
- (end-test-macro (gensym))
- (real-symbol-p (gensym))
- (inherited-symbol-p (gensym))
- (BLOCK (gensym)))
- `(let* ((,these-packages ,package-list)
- (,packages `,(mapcar (lambda (package)
- (if (packagep package)
- package
- ;; Maybe FIND-PACKAGE-OR-DIE?
- (or (find-package package)
- (error 'simple-package-error
- ;; could be a character
- :name (string package)
- :format-control "~@<~S does not name a package ~:>"
- :format-arguments (list package)))))
- (if (consp ,these-packages)
- ,these-packages
- (list ,these-packages))))
- (,counter nil)
- (,kind (car ,packages))
- (,hash-vector nil)
- (,vector nil)
- (,package-use-list nil))
- ,(if (member :inherited ordered-types)
- `(setf ,package-use-list (package-%use-list (car ,packages)))
- `(declare (ignore ,package-use-list)))
- (macrolet ((,init-macro (next-kind)
- (declare (optimize (inhibit-warnings 3)))
- (let ((symbols (gensym)))
- `(progn
- (setf ,',kind ,next-kind)
- (setf ,',counter nil)
- ,(case next-kind
- (:internal
- `(let ((,symbols (package-internal-symbols
- (car ,',packages))))
- (when ,symbols
- (setf ,',vector (package-hashtable-table ,symbols))
- (setf ,',hash-vector
- (package-hashtable-hash ,symbols)))))
- (:external
- `(let ((,symbols (package-external-symbols
- (car ,',packages))))
- (when ,symbols
- (setf ,',vector (package-hashtable-table ,symbols))
- (setf ,',hash-vector
- (package-hashtable-hash ,symbols)))))
- (:inherited
- `(let ((,symbols (and ,',package-use-list
- (package-external-symbols
- (car ,',package-use-list)))))
- (when ,symbols
- (setf ,',vector (package-hashtable-table ,symbols))
- (setf ,',hash-vector
- (package-hashtable-hash ,symbols)))))))))
- (,end-test-macro (this-kind)
- `,(let ((next-kind (cadr (member this-kind
- ',ordered-types))))
- (if next-kind
- `(,',init-macro ,next-kind)
- `(if (endp (setf ,',packages (cdr ,',packages)))
- (return-from ,',BLOCK)
- (,',init-macro ,(car ',ordered-types)))))))
- (when ,packages
- ,(when (null symbol-types)
- (error 'simple-program-error
- :format-control
- "At least one of :INTERNAL, :EXTERNAL, or ~
+such that successive invocations of (MNAME) will return the symbols, one by
+one, from the packages in PACKAGE-LIST. SYMBOL-TYPES may be any
+of :INHERITED :EXTERNAL :INTERNAL."
+ (with-unique-names (packages these-packages counter kind hash-vector vector
+ package-use-list init-macro end-test-macro real-symbol-p
+ inherited-symbol-p BLOCK)
+ (let ((ordered-types (let ((res nil))
+ (dolist (kind '(:inherited :external :internal) res)
+ (when (member kind symbol-types)
+ (push kind res)))))) ; Order SYMBOL-TYPES.
+ `(let* ((,these-packages ,package-list)
+ (,packages `,(mapcar (lambda (package)
+ (if (packagep package)
+ package
+ ;; Maybe FIND-PACKAGE-OR-DIE?
+ (or (find-package package)
+ (error 'simple-package-error
+ ;; could be a character
+ :package (string package)
+ :format-control "~@<~S does not name a package ~:>"
+ :format-arguments (list package)))))
+ (if (consp ,these-packages)
+ ,these-packages
+ (list ,these-packages))))
+ (,counter nil)
+ (,kind (car ,packages))
+ (,hash-vector nil)
+ (,vector nil)
+ (,package-use-list nil))
+ ,(if (member :inherited ordered-types)
+ `(setf ,package-use-list (package-%use-list (car ,packages)))
+ `(declare (ignore ,package-use-list)))
+ (macrolet ((,init-macro (next-kind)
+ (declare (optimize (inhibit-warnings 3)))
+ (let ((symbols (gensym)))
+ `(progn
+ (setf ,',kind ,next-kind)
+ (setf ,',counter nil)
+ ,(case next-kind
+ (:internal
+ `(let ((,symbols (package-internal-symbols
+ (car ,',packages))))
+ (when ,symbols
+ (setf ,',vector (package-hashtable-table ,symbols))
+ (setf ,',hash-vector
+ (package-hashtable-hash ,symbols)))))
+ (:external
+ `(let ((,symbols (package-external-symbols
+ (car ,',packages))))
+ (when ,symbols
+ (setf ,',vector (package-hashtable-table ,symbols))
+ (setf ,',hash-vector
+ (package-hashtable-hash ,symbols)))))
+ (:inherited
+ `(let ((,symbols (and ,',package-use-list
+ (package-external-symbols
+ (car ,',package-use-list)))))
+ (when ,symbols
+ (setf ,',vector (package-hashtable-table ,symbols))
+ (setf ,',hash-vector
+ (package-hashtable-hash ,symbols)))))))))
+ (,end-test-macro (this-kind)
+ `,(let ((next-kind (cadr (member this-kind
+ ',ordered-types))))
+ (if next-kind
+ `(,',init-macro ,next-kind)
+ `(if (endp (setf ,',packages (cdr ,',packages)))
+ (return-from ,',BLOCK)
+ (,',init-macro ,(car ',ordered-types)))))))
+ (when ,packages
+ ,(when (null symbol-types)
+ (error 'simple-program-error
+ :format-control
+ "At least one of :INTERNAL, :EXTERNAL, or ~