X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefpackage.lisp;h=ab297791b12fa1cd28951fc2d26239eac5facb6b;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=31a9e7da86ee9c3b6e980106d23f16dd6075a55e;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/defpackage.lisp b/src/code/defpackage.lisp index 31a9e7d..ab29779 100644 --- a/src/code/defpackage.lisp +++ b/src/code/defpackage.lisp @@ -11,6 +11,22 @@ (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 @@ -37,7 +53,7 @@ (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) @@ -45,14 +61,14 @@ (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 @@ -86,11 +102,11 @@ (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)) @@ -113,7 +129,7 @@ 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))))) @@ -128,8 +144,8 @@ (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 @@ -142,7 +158,7 @@ (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) @@ -190,7 +206,7 @@ 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))