(in-package "SB-COLD")
-;;;; $Header$
-
;;; an entry in the table which describes the non-standard part (i.e. not
;;; CL/CL-USER/KEYWORD) of the package structure of the SBCL system
;;;
;;; able to express features which we don't happen to use.
(export '(package-data
package-data-name
- package-data-nicknames
package-data-export
package-data-reexport
package-data-import-from
(name (error "missing PACKAGE-DATA-NAME datum"))
;; a doc string
(doc (error "missing PACKAGE-DOC datum"))
- ;; a list of string designators for package nicknames
- nicknames
;; a tree containing names for exported symbols which'll be set up at package
;; creation time, and NILs, which are ignored. (This is a tree in order to
;; allow constructs like '("ENOSPC" #!+LINUX ("EDQUOT" "EISNAM" "ENAVAIL"
(dolist (package-data package-data-list)
(let* ((package (make-package
(package-data-name package-data)
- :nicknames (package-data-nicknames package-data)
+ ;; Note: As of 0.7.0, the only nicknames we use
+ ;; for our implementation packages are hacks
+ ;; not needed at cross-compile time (e.g. the
+ ;; deprecated SB-C-CALL nickname for SB-ALIEN).
+ ;; So support for nicknaming during xc is gone,
+ ;; since any nicknames are hacked in during
+ ;; cold init.
+ :nicknames nil
:use nil)))
- #!+sb-doc (setf (documentation package t)
- (package-data-doc package-data))
+ #-clisp ; As of "2.27 (released 2001-07-17) (built 3215971334)"
+ ; CLISP didn't support DOCUMENTATION on PACKAGE values.
+ (progn
+ #!+sb-doc (setf (documentation package t)
+ (package-data-doc package-data)))
;; Walk the tree of exported names, exporting each name.
(labels ((recurse (tree)
(etypecase tree
;; Now that all package-package references exist, we can handle
;; REEXPORT operations. (We have to wait until now because they
- ;; interact with USE operations.) KLUDGE: This code doesn't detect
- ;; dependencies and do exports in proper order to work around them, so
- ;; it could break randomly (with build-time errors, not with silent
- ;; errors or runtime errors) if multiple levels of re-exportation are
- ;; used, e.g. package A exports X, package B uses A and reexports X,
- ;; and package C uses B and reexports X. That doesn't seem to be an
- ;; issue in the current code, and it's hard to see why anyone would
- ;; want to do it, and it should be straightforward (though tedious) to
- ;; extend the code here to deal with that if it ever becomes necessary.
- (dolist (package-data package-data-list)
- (let ((package (find-package (package-data-name package-data))))
- (dolist (symbol-name (package-data-reexport package-data))
- (multiple-value-bind (symbol status)
- (find-symbol symbol-name package)
- (unless status
- (error "No symbol named ~S is accessible in ~S."
- symbol-name
- package))
- (when (eq (symbol-package symbol) package)
- (error "~S is not inherited/imported, but native to ~S."
- symbol-name
- package))
- (export symbol package))))))
+ ;; interact with USE operations.) This code handles dependencies
+ ;; properly, but is somewhat ugly.
+ (let (done)
+ (labels
+ ((reexport (package-data)
+ (let ((package (find-package (package-data-name package-data))))
+ (cond
+ ((member package done))
+ ((null (package-data-reexport package-data))
+ (push package done))
+ (t
+ (mapcar #'reexport
+ (remove-if-not
+ (lambda (x)
+ (member x (package-data-use package-data)
+ :test #'string=))
+ package-data-list
+ :key #'package-data-name))
+ (dolist (symbol-name (package-data-reexport package-data))
+ (multiple-value-bind (symbol status)
+ (find-symbol symbol-name package)
+ (unless status
+ (error "No symbol named ~S is accessible in ~S."
+ symbol-name package))
+ (when (eq (symbol-package symbol) package)
+ (error
+ "~S is not inherited/imported, but native to ~S."
+ symbol-name package))
+ (export symbol package)))
+ (push package done))))))
+ (dolist (x package-data-list)
+ (reexport x))
+ (assert (= (length done) (length package-data-list))))))
projects / sbcl.git / blobdiff