(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
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))