+;;;; DEFCLASS macro and close personal friends
+
+;;; ANSI says (Macro DEFCLASS, section 7.7) that DEFCLASS, if it
+;;; "appears as a top level form, the compiler must make the class
+;;; name be recognized as a valid type name in subsequent declarations
+;;; (as for deftype) and be recognized as a valid class name for
+;;; defmethod parameter specializers and for use as the :metaclass
+;;; option of a subsequent defclass."
+(defun preinform-compiler-about-class-type (name)
+ ;; Unless the type system already has an actual type attached to
+ ;; NAME (in which case (1) writing a placeholder value over that
+ ;; actual type as a compile-time side-effect would probably be a bad
+ ;; idea and (2) anyway we don't need to modify it in order to make
+ ;; NAME be recognized as a valid type name)
+ (unless (info :type :kind name)
+ ;; Tell the compiler to expect a class with the given NAME, by
+ ;; writing a kind of minimal placeholder type information. This
+ ;; placeholder will be overwritten later when the class is defined.
+ (setf (info :type :kind name) :forthcoming-defclass-type))
+ (values))
+
+(defun preinform-compiler-about-accessors (readers writers slots)
+ (flet ((inform (name type)
+ ;; FIXME: This matches what PROCLAIM FTYPE does, except
+ ;; that :WHERE-FROM is :DEFINED, not :DECLARED, and should
+ ;; probably be factored into a common function -- eg.
+ ;; (%proclaim-ftype name declared-or-defined).
+ (when (eq (info :function :where-from name) :assumed)
+ (proclaim-as-fun-name name)
+ (note-name-defined name :function)
+ (setf (info :function :where-from name) :defined
+ (info :function :type name) type))))
+ (let ((rtype (specifier-type '(function (t) t)))
+ (wtype (specifier-type '(function (t t) t))))
+ (dolist (reader readers)
+ (inform reader rtype))
+ (dolist (writer writers)
+ (inform writer wtype))
+ (dolist (slot slots)
+ (inform (slot-reader-name slot) rtype)
+ (inform (slot-boundp-name slot) rtype)
+ (inform (slot-writer-name slot) wtype)))))
+
+;;; state for the current DEFCLASS expansion
+(defvar *initfunctions-for-this-defclass*)
+(defvar *readers-for-this-defclass*)
+(defvar *writers-for-this-defclass*)
+(defvar *slot-names-for-this-defclass*)