(sb!xc:defstruct (package-hashtable (:constructor %make-package-hashtable ())
(:copier nil))
;; The g-vector of symbols.
- ;; FIXME: could just be type SIMPLE-VECTOR, with REQUIRED-ARGUMENT
+ ;; FIXME: could just be type SIMPLE-VECTOR, with (MISSING-ARG) default
(table nil :type (or simple-vector null))
;; The i-vector of pname hash values.
- ;; FIXME: could just be type HASH-VECTOR, with REQUIRED-ARGUMENT
+ ;; FIXME: could just be type HASH-VECTOR, with (MISSING-ARG) default
(hash nil :type (or hash-vector null))
;; The total number of entries allowed before resizing.
;;
;;; KLUDGE: We use DEF!STRUCT to define this not because we need to
;;; manipulate target package objects on the cross-compilation host,
;;; but only because its MAKE-LOAD-FORM function needs to be hooked
-;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system. The DEF!STRUCT
-;;; side-effect of defining a new PACKAGE type on the
+;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system so that we can
+;;; compile things like IN-PACKAGE in warm init before CLOS is set up.
+;;; The DEF!STRUCT side effect of defining a new PACKAGE type on the
;;; cross-compilation host is just a nuisance, and in order to avoid
;;; breaking the cross-compilation host, we need to work around it
;;; around by putting the new PACKAGE type (and the PACKAGEP predicate
;; packages that use this package
(%used-by-list () :type list)
;; PACKAGE-HASHTABLEs of internal & external symbols
- (internal-symbols (required-argument) :type package-hashtable)
- (external-symbols (required-argument) :type package-hashtable)
+ (internal-symbols (missing-arg) :type package-hashtable)
+ (external-symbols (missing-arg) :type package-hashtable)
;; shadowing symbols
(%shadowing-symbols () :type list)
;; documentation string for this package
"DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}*
Executes the FORMs at least once for each symbol accessible in the given
PACKAGE with VAR bound to the current symbol."
- (multiple-value-bind (body decls) body-decls
+ (multiple-value-bind (body decls) (parse-body body-decls nil)
(let ((flet-name (gensym "DO-SYMBOLS-")))
`(block nil
(flet ((,flet-name (,var)
(inherited-symbol-p (gensym))
(BLOCK (gensym)))
`(let* ((,these-packages ,package-list)
- (,packages `,(mapcar #'(lambda (package)
- (if (packagep package)
- package
- (find-package package)))
+ (,packages `,(mapcar (lambda (package)
+ (if (packagep package)
+ package
+ (find-package package)))
(if (consp ,these-packages)
,these-packages
(list ,these-packages))))
(car ,',packages))))
(when ,symbols
(setf ,',vector (package-hashtable-table ,symbols))
- (setf ,',hash-vector (package-hashtable-hash ,symbols)))))
+ (setf ,',hash-vector
+ (package-hashtable-hash ,symbols)))))
(:external
`(let ((,symbols (package-external-symbols
(car ,',packages))))
(,',init-macro ,(car ',ordered-types)))))))
(when ,packages
,(when (null symbol-types)
- (error 'program-error
+ (error 'simple-program-error
:format-control
- "Must supply at least one of :internal, :external, or ~
- :inherited."))
+ "At least one of :INTERNAL, :EXTERNAL, or ~
+ :INHERITED must be supplied."))
,(dolist (symbol symbol-types)
(unless (member symbol '(:internal :external :inherited))
(error 'program-error
:format-control
- "~S is not one of :internal, :external, or :inherited."
+ "~S is not one of :INTERNAL, :EXTERNAL, or :INHERITED."
:format-argument symbol)))
(,init-macro ,(car ordered-types))
(flet ((,real-symbol-p (number)