- ,@(mapcar (lambda (x)
- `(declaim (ftype (function (t) t) ,x)))
- *readers*)
- ,@(mapcar (lambda (x)
- `(declaim (ftype (function (t t) t) ,x)))
- *writers*)
- (let ,(mapcar #'cdr *initfunctions*)
- (load-defclass ',name
- ',metaclass
- ',supers
- (list ,@canonical-slots)
- (list ,@(apply #'append
- (when defstruct-p
- '(:from-defclass-p t))
- other-initargs)))))))
- (if defstruct-p
- (progn
- ;; FIXME: The ANSI way to do this is with EVAL-WHEN
- ;; forms, not by side-effects at macroexpansion time.
- ;; But I (WHN 2001-09-02) am not even sure how to
- ;; reach this code path with ANSI (or art-of-the-MOP)
- ;; code, so I haven't tried to update it, since for
- ;; all I know maybe it could just be deleted instead.
- (eval defclass-form) ; Define the class now, so that..
- `(progn ; ..the defstruct can be compiled.
- ,(class-defstruct-form (find-class name))
- ,defclass-form))
- `(progn
- ;; By telling the type system at compile time about
- ;; the existence of a class named NAME, we can avoid
- ;; various bogus warnings about "type isn't defined yet".
- ,(when (and
- ;; But it's not so important to get rid of
- ;; "not defined yet" warnings during
- ;; bootstrapping, and machinery like
- ;; INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS
- ;; mightn't be defined yet. So punt then.
- (eq *boot-state* 'complete)
- ;; And although we know enough about
- ;; STANDARD-CLASS, and ANSI imposes enough
- ;; restrictions on the user overloading its
- ;; methods, that (1) we can shortcut the
- ;; method dispatch and do an ordinary
- ;; function call, and (2) be sure we're getting
- ;; it right even when we do it at compile
- ;; time; we don't in general know how to do
- ;; that for other classes. So punt then too.
- (eq metaclass 'standard-class))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (inform-type-system-about-std-class ',name)))
- ,defclass-form)))))))
+ ;; By telling the type system at compile time about
+ ;; the existence of a class named NAME, we can avoid
+ ;; various bogus warnings about "type isn't defined yet"
+ ;; for code elsewhere in the same file which uses
+ ;; the name of the type.
+ ;;
+ ;; We only need to do this at compile time, because
+ ;; at load and execute time we write the actual
+ ;; full-blown class, so the "a class of this name is
+ ;; coming" note we write here would be irrelevant.
+ (eval-when (:compile-toplevel)
+ (%compiler-defclass ',name
+ ',*readers-for-this-defclass*
+ ',*writers-for-this-defclass*
+ ',*slot-names-for-this-defclass*))
+ (eval-when (:load-toplevel :execute)
+ ,defclass-form)))))))))
+
+(defun %compiler-defclass (name readers writers slot-names)
+ (with-single-package-locked-error (:symbol name "defining ~A as a class")
+ (preinform-compiler-about-class-type name)
+ (proclaim `(ftype (function (t) t)
+ ,@readers
+ ,@(mapcar #'slot-reader-name slot-names)
+ ,@(mapcar #'slot-boundp-name slot-names)))
+ (proclaim `(ftype (function (t t) t)
+ ,@writers ,@(mapcar #'slot-writer-name slot-names)))))