(defvar *initfunctions-for-this-defclass*)
(defvar *readers-for-this-defclass*)
(defvar *writers-for-this-defclass*)
+(defvar *slot-names-for-this-defclass*)
;;; Like the DEFMETHOD macro, the expansion of the DEFCLASS macro is
;;; fixed. DEFCLASS always expands into a call to LOAD-DEFCLASS. Until
(let ((*initfunctions-for-this-defclass* ())
(*readers-for-this-defclass* ()) ;Truly a crock, but we got
- (*writers-for-this-defclass* ())) ;to have it to live nicely.
+ (*writers-for-this-defclass* ()) ;to have it to live nicely.
+ (*slot-names-for-this-defclass* ()))
(let ((canonical-slots
(mapcar (lambda (spec)
(canonicalize-slot-specification name spec))
,@(mapcar (lambda (x)
`(declaim (ftype (function (t t) t) ,x)))
*writers-for-this-defclass*)
+ ,@(mapcar (lambda (x)
+ `(declaim (ftype (function (t) t)
+ ,(slot-reader-name x)
+ ,(slot-boundp-name x))
+ (ftype (function (t t) t)
+ ,(slot-writer-name x))))
+ *slot-names-for-this-defclass*)
(let ,(mapcar #'cdr *initfunctions-for-this-defclass*)
(load-defclass ',name
',metaclass
(cond ((and (symbolp spec)
(not (keywordp spec))
(not (memq spec '(t nil))))
+ (push spec *slot-names-for-this-defclass*)
`'(:name ,spec))
((not (consp spec))
(error "~S is not a legal slot specification." spec))
((null (cdr spec))
+ (push (car spec) *slot-names-for-this-defclass*)
`'(:name ,(car spec)))
((null (cddr spec))
(error "In DEFCLASS ~S, the slot specification ~S is obsolete.~%~
(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)
(if (eq initform unsupplied)
`(list* ,@spec)
`(list* :initfunction ,(make-initfunction initform) ,@spec))))))
-
+
(defun canonicalize-defclass-option (class-name option)
(declare (ignore class-name))
(case (car option)
canonical-options (copy-tree canonical-options))
(let ((ecd
(make-early-class-definition name
- *load-truename*
+ *load-pathname*
metaclass
supers
canonical-slots