(in-package "SB!IMPL")
+;;; the list of packages to use by default when no :USE argument is
+;;; supplied to MAKE-PACKAGE or other package creation forms
+;;;
+;;; ANSI specifies (1) that MAKE-PACKAGE and DEFPACKAGE use the same
+;;; value, and (2) that it (as an implementation-defined value) should
+;;; be documented, which we do in the doc string. So for OAOO reasons
+;;; we represent this value as a variable only at compile time, and
+;;; then use #. readmacro hacks to splice it into the target code as a
+;;; constant.
+(eval-when (:compile-toplevel)
+ (defparameter *default-package-use-list*
+ ;; ANSI says this is implementation-defined. So we make it NIL,
+ ;; the way God intended. Anyone who actually wants a random value
+ ;; is free to :USE (PACKAGE-USE-LIST :CL-USER) anyway.:-|
+ nil))
+
(defmacro defpackage (package &rest options)
#!+sb-doc
"Defines a new package called PACKAGE. Each of OPTIONS should be one of the
(doc nil))
(dolist (option options)
(unless (consp option)
- (error 'program-error
+ (error 'simple-program-error
:format-control "bogus DEFPACKAGE option: ~S"
:format-arguments (list option)))
(case (car option)
(setf nicknames (stringify-names (cdr option) "package")))
(:size
(cond (size
- (error 'program-error
+ (error 'simple-program-error
:format-control "can't specify :SIZE twice."))
((and (consp (cdr option))
(typep (second option) 'unsigned-byte))
(setf size (second option)))
(t
(error
- 'program-error
+ 'simple-program-error
:format-control ":SIZE is not a positive integer: ~S"
:format-arguments (list (second option))))))
(:shadow
(setf exports (append exports new))))
(:documentation
(when doc
- (error 'program-error
+ (error 'simple-program-error
:format-control "multiple :DOCUMENTATION options"))
(setf doc (coerce (second option) 'simple-string)))
(t
- (error 'program-error
+ (error 'simple-program-error
:format-control "bogus DEFPACKAGE option: ~S"
:format-arguments (list option)))))
(check-disjoint `(:intern ,@interns) `(:export ,@exports))
with x = (car list)
for y in (rest list)
for z = (remove-duplicates (intersection (cdr x)(cdr y) :test #'string=))
- when z do (error 'program-error
+ when z do (error 'simple-program-error
:format-control "Parameters ~S and ~S must be disjoint ~
but have common elements ~% ~S"
:format-arguments (list (car x)(car y) z)))))
(error "bogus ~A name: ~S" kind name))))
(defun stringify-names (names kind)
- (mapcar #'(lambda (name)
- (stringify-name name kind))
+ (mapcar (lambda (name)
+ (stringify-name name kind))
names))
(defun %defpackage (name nicknames size shadows shadowing-imports
(let ((package (or (find-package name)
(progn
(when (eq use :default)
- (setf use *default-package-use-list*))
+ (setf use '#.*default-package-use-list*))
(make-package name
:use nil
:internal-symbols (or size 10)
package))))
;; Handle exports.
(let ((old-exports nil)
- (exports (mapcar #'(lambda (sym-name) (intern sym-name package))
+ (exports (mapcar (lambda (sym-name) (intern sym-name package))
exports)))
(do-external-symbols (sym package)
(push sym old-exports))