- ((null (cddr spec))
- (error "In DEFCLASS ~S, the slot specification ~S is obsolete.~%~
- Convert it to ~S"
- class-name spec (list (car spec) :initform (cadr spec))))
- (t
- (let* ((name (pop spec))
- (readers ())
- (writers ())
- (initargs ())
- (unsupplied (list nil))
- (initform (getf spec :initform unsupplied)))
- (push name *slot-names-for-this-defclass*)
- (doplist (key val) spec
- (case key
- (:accessor (push val readers)
- (push `(setf ,val) writers))
- (:reader (push val readers))
- (:writer (push val writers))
- (:initarg (push val initargs))))
- (loop (unless (remf spec :accessor) (return)))
- (loop (unless (remf spec :reader) (return)))
- (loop (unless (remf spec :writer) (return)))
- (loop (unless (remf spec :initarg) (return)))
- (setq *writers-for-this-defclass*
- (append writers *writers-for-this-defclass*))
- (setq *readers-for-this-defclass*
- (append readers *readers-for-this-defclass*))
- (setq spec `(:name ',name
- :readers ',readers
- :writers ',writers
- :initargs ',initargs
- ',spec))
- (if (eq initform unsupplied)
- `(list* ,@spec)
- `(list* :initfunction ,(make-initfunction initform) ,@spec))))))
+ ((null (cddr spec))
+ (error 'simple-program-error
+ :format-control
+ "~@<in DEFCLASS ~S, the slot specification ~S is invalid; ~
+ the probable intended meaning may be achieved by ~
+ specifiying ~S instead."
+ :format-arguments
+ (list class-name spec
+ `(,(car spec) :initform ,(cadr spec)))))
+ (t
+ (let* ((name (car spec))
+ (spec (cdr spec))
+ (readers ())
+ (writers ())
+ (initargs ())
+ (unsupplied (list nil))
+ (initform (getf spec :initform unsupplied)))
+ (check-slot-name-legality name)
+ (push name *slot-names-for-this-defclass*)
+ (doplist (key val) spec
+ (case key
+ (:accessor (push val readers)
+ (push `(setf ,val) writers))
+ (:reader (push val readers))
+ (:writer (push val writers))
+ (:initarg (push val initargs))))
+ (loop (unless (remf spec :accessor) (return)))
+ (loop (unless (remf spec :reader) (return)))
+ (loop (unless (remf spec :writer) (return)))
+ (loop (unless (remf spec :initarg) (return)))
+ (setq *writers-for-this-defclass*
+ (append writers *writers-for-this-defclass*))
+ (setq *readers-for-this-defclass*
+ (append readers *readers-for-this-defclass*))
+ (setq spec `(:name ',name
+ :readers ',readers
+ :writers ',writers
+ :initargs ',initargs
+ ',spec))
+ (if (eq initform unsupplied)
+ `(list* ,@spec)
+ `(list* :initfunction ,(make-initfunction initform)
+ ,@spec)))))))