- (:nicknames
- (setf nicknames (stringify-names (cdr option) "package")))
- (:size
- (cond (size
- (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
- 'simple-program-error
- :format-control ":SIZE is not a positive integer: ~S"
- :format-arguments (list (second option))))))
- (:shadow
- (let ((new (stringify-names (cdr option) "symbol")))
- (setf shadows (append shadows new))))
- (:shadowing-import-from
- (let ((package-name (stringify-name (second option) "package"))
- (names (stringify-names (cddr option) "symbol")))
- (let ((assoc (assoc package-name shadowing-imports
- :test #'string=)))
- (if assoc
- (setf (cdr assoc) (append (cdr assoc) names))
- (setf shadowing-imports
- (acons package-name names shadowing-imports))))))
- (:use
- (setf use (append use (stringify-names (cdr option) "package") )
- use-p t))
- (:import-from
- (let ((package-name (stringify-name (second option) "package"))
- (names (stringify-names (cddr option) "symbol")))
- (let ((assoc (assoc package-name imports
- :test #'string=)))
- (if assoc
- (setf (cdr assoc) (append (cdr assoc) names))
- (setf imports (acons package-name names imports))))))
- (:intern
- (let ((new (stringify-names (cdr option) "symbol")))
- (setf interns (append interns new))))
- (:export
- (let ((new (stringify-names (cdr option) "symbol")))
- (setf exports (append exports new))))
- (:documentation
- (when doc
- (error 'simple-program-error
- :format-control "multiple :DOCUMENTATION options"))
- (setf doc (coerce (second option) 'simple-string)))
- (t
- (error 'simple-program-error
- :format-control "bogus DEFPACKAGE option: ~S"
- :format-arguments (list option)))))
+ (:nicknames
+ (setf nicknames (stringify-names (cdr option) "package")))
+ (:size
+ (cond (size
+ (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
+ 'simple-program-error
+ :format-control ":SIZE is not a positive integer: ~S"
+ :format-arguments (list (second option))))))
+ (:shadow
+ (let ((new (stringify-names (cdr option) "symbol")))
+ (setf shadows (append shadows new))))
+ (:shadowing-import-from
+ (let ((package-name (stringify-name (second option) "package"))
+ (names (stringify-names (cddr option) "symbol")))
+ (let ((assoc (assoc package-name shadowing-imports
+ :test #'string=)))
+ (if assoc
+ (setf (cdr assoc) (append (cdr assoc) names))
+ (setf shadowing-imports
+ (acons package-name names shadowing-imports))))))
+ (:use
+ (setf use (append use (stringify-names (cdr option) "package") )
+ use-p t))
+ (:import-from
+ (let ((package-name (stringify-name (second option) "package"))
+ (names (stringify-names (cddr option) "symbol")))
+ (let ((assoc (assoc package-name imports
+ :test #'string=)))
+ (if assoc
+ (setf (cdr assoc) (append (cdr assoc) names))
+ (setf imports (acons package-name names imports))))))
+ (:intern
+ (let ((new (stringify-names (cdr option) "symbol")))
+ (setf interns (append interns new))))
+ (:export
+ (let ((new (stringify-names (cdr option) "symbol")))
+ (setf exports (append exports new))))
+ #!+sb-package-locks
+ (:implement
+ (unless implement-p
+ (setf implement nil))
+ (let ((new (stringify-names (cdr option) "package")))
+ (setf implement (append implement new)
+ implement-p t)))
+ #!+sb-package-locks
+ (:lock
+ (when lock
+ (error 'simple-program-error
+ :format-control "multiple :LOCK options"))
+ (setf lock (coerce (second option) 'boolean)))
+ (:documentation
+ (when doc
+ (error 'simple-program-error
+ :format-control "multiple :DOCUMENTATION options"))
+ (setf doc (coerce (second option) 'simple-string)))
+ (t
+ (error 'simple-program-error
+ :format-control "bogus DEFPACKAGE option: ~S"
+ :format-arguments (list option)))))