X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-package.lisp;h=3759f74106fb6ac0945a144619b98470e41718ee;hb=83fd554b67913275d8dc06edcad8b2f065c89c49;hp=c4aa06e7f78322426776c71cd60e9a3f4786ade6;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index c4aa06e..3759f74 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -107,34 +107,10 @@ (defun package-external-symbol-count (package) (stuff (package-external-symbols package)))) -(defvar *package* () ; actually initialized in cold load +(defvar *package* (error "*PACKAGE* should be initialized in cold load!") #!+sb-doc "the current package") ;;; FIXME: should be declared of type PACKAGE, with no NIL init form, ;;; after I get around to cleaning up DOCUMENTATION -;;; -;;; FIXME: Setting *PACKAGE* to a non-PACKAGE value (even a plausible -;;; one, like :CL-USER) makes the system fairly unusable, without -;;; generating useful diagnostics. Is it possible to handle this -;;; situation more gracefully by replacing references to *PACKAGE* -;;; with references to (DEFAULT-PACKAGE) and implementing -;;; DEFAULT-PACKAGE so that it checks for the PACKAGEness of *PACKAGE* -;;; and helps the user to fix any problem (perhaps going through -;;; CERROR)? -;;; Error: An attempt was made to use the *PACKAGE* variable when it was -;;; bound to the illegal (non-PACKAGE) value ~S. This is -;;; forbidden by the ANSI specification and could have made -;;; the system very confused. The *PACKAGE* variable has been -;;; temporarily reset to #. How -;;; would you like to proceed? -;;; NAMED Set *PACKAGE* to ~S (which is the package which is -;;; named by the old illegal ~S value of *PACKAGE*, and -;;; is thus very likely the intended value) and continue -;;; without signalling an error. -;;; ERROR Leave *PACKAGE* set to # -;;; and signal PACKAGE-ERROR to the code which tried to -;;; use the old illegal value of *PACKAGE*. -;;; CONTINUE Leave *PACKAGE* set to # -;;; and continue without signalling an error. ;;; a map from package names to packages (defvar *package-names*) @@ -301,7 +277,7 @@ ;;; If there is a conflict then give the user a chance to do ;;; something about it. (defun enter-new-nicknames (package nicknames) - (check-type nicknames list) + (declare (type list nicknames)) (dolist (n nicknames) (let* ((n (package-namify n)) (found (gethash n *package-names*))) @@ -456,7 +432,7 @@ *package-names*) res)) -(defun intern (name &optional (package *package*)) +(defun intern (name &optional (package (sane-package))) #!+sb-doc "Returns a symbol having the specified name, creating it if necessary." ;; We just simple-stringify the name and call INTERN*, where the real @@ -469,7 +445,7 @@ (length name) (find-undeleted-package-or-lose package)))) -(defun find-symbol (name &optional (package *package*)) +(defun find-symbol (name &optional (package (sane-package))) #!+sb-doc "Returns the symbol named String in Package. If such a symbol is found then the second value is :internal, :external or :inherited to indicate @@ -541,7 +517,7 @@ ;;; If we are uninterning a shadowing symbol, then a name conflict can ;;; result, otherwise just nuke the symbol. -(defun unintern (symbol &optional (package *package*)) +(defun unintern (symbol &optional (package (sane-package))) #!+sb-doc "Makes Symbol no longer present in Package. If Symbol was present then T is returned, otherwise NIL. If Package is Symbol's home @@ -617,7 +593,7 @@ (unintern symbol q) (return t)))))))))) -(defun export (symbols &optional (package *package*)) +(defun export (symbols &optional (package (sane-package))) #!+sb-doc "Exports Symbols from Package, checking that no name conflicts result." (let ((package (find-undeleted-package-or-lose package)) @@ -692,7 +668,7 @@ t)) ;;; Check that all symbols are accessible, then move from external to internal. -(defun unexport (symbols &optional (package *package*)) +(defun unexport (symbols &optional (package (sane-package))) #!+sb-doc "Makes Symbols no longer exported from Package." (let ((package (find-undeleted-package-or-lose package)) @@ -715,7 +691,7 @@ ;;; Check for name conflict caused by the import and let the user ;;; shadowing-import if there is. -(defun import (symbols &optional (package *package*)) +(defun import (symbols &optional (package (sane-package))) #!+sb-doc "Make Symbols accessible as internal symbols in Package. If a symbol is already accessible then it has no effect. If a name conflict @@ -755,7 +731,7 @@ ;;; If a conflicting symbol is present, unintern it, otherwise just ;;; stick the symbol in. -(defun shadowing-import (symbols &optional (package *package*)) +(defun shadowing-import (symbols &optional (package (sane-package))) #!+sb-doc "Import Symbols into package, disregarding any name conflict. If a symbol of the same name is present, then it is uninterned. @@ -774,7 +750,7 @@ (pushnew sym (package-%shadowing-symbols package))))) t) -(defun shadow (symbols &optional (package *package*)) +(defun shadow (symbols &optional (package (sane-package))) #!+sb-doc "Make an internal symbol in Package with the same name as each of the specified symbols, adding the new symbols to the Package-Shadowing-Symbols. @@ -794,7 +770,7 @@ t) ;;; Do stuff to use a package, with all kinds of fun name-conflict checking. -(defun use-package (packages-to-use &optional (package *package*)) +(defun use-package (packages-to-use &optional (package (sane-package))) #!+sb-doc "Add all the Packages-To-Use to the use list for Package so that the external symbols of the used packages are accessible as internal @@ -855,7 +831,7 @@ (push package (package-%used-by-list pkg))))) t) -(defun unuse-package (packages-to-unuse &optional (package *package*)) +(defun unuse-package (packages-to-unuse &optional (package (sane-package))) #!+sb-doc "Remove Packages-To-Unuse from the use list for Package." (let ((package (find-undeleted-package-or-lose package))) @@ -945,8 +921,8 @@ (let* ((pkg (apply #'make-package (first spec))) (internal (package-internal-symbols pkg)) (external (package-external-symbols pkg))) - (/show0 "back from MAKE-PACKAGE") - #!+sb-show (sb!sys:%primitive print (package-name pkg)) + (/show0 "back from MAKE-PACKAGE, PACKAGE-NAME=..") + (/primitive-print (package-name pkg)) ;; Put internal symbols in the internal hashtable and set package. (dolist (symbol (second spec)) @@ -967,23 +943,30 @@ ;; Put shadowing symbols in the shadowing symbols list. (setf (package-%shadowing-symbols pkg) (sixth spec)))) + ;; FIXME: These assignments are also done at toplevel in + ;; boot-extensions.lisp. They should probably only be done once. + (/show0 "setting up *CL-PACKAGE* and *KEYWORD-PACKAGE*") + (setq *cl-package* (find-package "COMMON-LISP")) + (setq *keyword-package* (find-package "KEYWORD")) + (/show0 "about to MAKUNBOUND *!INITIAL-SYMBOLS*") (makunbound '*!initial-symbols*) ; (so that it gets GCed) - ;; Make some other packages that should be around in the cold load. The - ;; COMMON-LISP-USER package is required by the ANSI standard, but not - ;; completely specified by it, so in the cross-compilation host Lisp it could - ;; contain various symbols, USE-PACKAGEs, or nicknames that we don't want in - ;; our target SBCL. For that reason, we handle it specially, not dumping the - ;; host Lisp version at genesis time.. - (assert (not (find-package "COMMON-LISP-USER"))) + ;; Make some other packages that should be around in the cold load. + ;; The COMMON-LISP-USER package is required by the ANSI standard, + ;; but not completely specified by it, so in the cross-compilation + ;; host Lisp it could contain various symbols, USE-PACKAGEs, or + ;; nicknames that we don't want in our target SBCL. For that reason, + ;; we handle it specially, not dumping the host Lisp version at + ;; genesis time.. + (aver (not (find-package "COMMON-LISP-USER"))) ;; ..but instead making our own from scratch here. (/show0 "about to MAKE-PACKAGE COMMON-LISP-USER") (make-package "COMMON-LISP-USER" :nicknames '("CL-USER") :use '("COMMON-LISP" - ;; ANSI encourages us to put extension packages in the - ;; USE list of COMMON-LISP-USER. + ;; ANSI encourages us to put extension packages + ;; in the USE list of COMMON-LISP-USER. "SB!ALIEN" "SB!C-CALL" "SB!DEBUG" "SB!EXT" "SB!GRAY" "SB!PROFILE")) @@ -996,16 +979,11 @@ (/show0 "about to SETQ *IN-PACKAGE-INIT*") (setq *in-package-init* nil) - ;; FIXME: These assignments are also done at toplevel in - ;; boot-extensions.lisp. They should probably only be done once. - (setq *cl-package* (find-package "COMMON-LISP")) - (setq *keyword-package* (find-package "KEYWORD")) - ;; For the kernel core image wizards, set the package to *CL-PACKAGE*. ;; - ;; FIXME: We should just set this to (FIND-PACKAGE "COMMON-LISP-USER") - ;; once and for all here, instead of setting it once here and resetting - ;; it later. + ;; FIXME: We should just set this to (FIND-PACKAGE + ;; "COMMON-LISP-USER") once and for all here, instead of setting it + ;; once here and resetting it later. (setq *package* *cl-package*)) (!cold-init-forms