;;; build, of course, but they might happen if someone is experimenting
;;; and debugging, and it's probably worth complaining if they do,
;;; so we've left 'em in.)
-(when (eq *boot-state* 'complete)
+(when (eq **boot-state** 'complete)
(error "Trying to load (or compile) PCL in an environment in which it~%~
has already been loaded. This doesn't work, you will have to~%~
get a fresh lisp (reboot) and then load PCL."))
-(when *boot-state*
+(when **boot-state**
(cerror "Try loading (or compiling) PCL anyways."
"Trying to load (or compile) PCL in an environment in which it~%~
has already been partially loaded. This may not work, you may~%~
need to get a fresh lisp (reboot) and then load PCL."))
\f
-;;; comments from CMU CL version of PCL:
-;;; This is like fdefinition on the Lispm. If Common Lisp had
-;;; something like function specs I wouldn't need this. On the other
-;;; hand, I don't like the way this really works so maybe function
-;;; specs aren't really right either?
-;;; I also don't understand the real implications of a Lisp-1 on this
-;;; sort of thing. Certainly some of the lossage in all of this is
-;;; because these SPECs name global definitions.
-;;; Note that this implementation is set up so that an implementation
-;;; which has a 'real' function spec mechanism can use that instead
-;;; and in that way get rid of setf generic function names.
-(defmacro parse-gspec (spec
- (non-setf-var . non-setf-case))
- `(let ((,non-setf-var ,spec)) ,@non-setf-case))
-
-;;; If symbol names a function which is traced, return the untraced
-;;; definition. This lets us get at the generic function object even
-;;; when it is traced.
-(defun unencapsulated-fdefinition (symbol)
- (fdefinition symbol))
-
-;;; If symbol names a function which is traced, redefine the `real'
-;;; definition without affecting the trace.
-(defun fdefine-carefully (name new-definition)
- (progn
- (sb-c::note-name-defined name :function)
- new-definition)
- (setf (fdefinition name) new-definition))
-
-(defun gboundp (spec)
- (parse-gspec spec
- (name (fboundp name))))
-
-(defun gmakunbound (spec)
- (parse-gspec spec
- (name (fmakunbound name))))
-
+#-sb-fluid (declaim (inline gdefinition))
(defun gdefinition (spec)
- (parse-gspec spec
- (name (unencapsulated-fdefinition name))))
+ ;; This is null layer right now, but once FDEFINITION stops bypasssing
+ ;; fwrappers/encapsulations we can do that here.
+ (fdefinition spec))
(defun (setf gdefinition) (new-value spec)
- (parse-gspec spec
- (name (fdefine-carefully name new-value))))
+ ;; This is almost a null layer right now, but once (SETF
+ ;; FDEFINITION) stops bypasssing fwrappers/encapsulations we can do
+ ;; that here.
+ (sb-c::note-name-defined spec :function) ; FIXME: do we need this? Why?
+ (setf (fdefinition spec) new-value))
\f
;;;; type specifier hackery
;;; interface
(defun specializer-from-type (type &aux args)
+ (when (symbolp type)
+ (return-from specializer-from-type (find-class type)))
(when (consp type)
(setq args (cdr type) type (car type)))
(cond ((symbolp type)
- (or (and (null args) (find-class type))
- (ecase type
+ (or (ecase type
(class (coerce-to-class (car args)))
(prototype (make-instance 'class-prototype-specializer
:object (coerce-to-class (car args))))
;; FIXME: do we still need this?
((and (null args) (typep type 'classoid))
(or (classoid-pcl-class type)
- (ensure-non-standard-class (classoid-name type))))
+ (ensure-non-standard-class (classoid-name type) type)))
((specializerp type) type)))
;;; interface
(when (symbolp specl)
;;maybe (or (find-class specl nil) (ensure-class specl)) instead?
(setq specl (find-class specl)))
- (or (not (eq *boot-state* 'complete))
+ (or (not (eq **boot-state** 'complete))
(specializerp specl)))
(specializer-type specl))
(t
(let ((type (specializer-type class)))
(if (listp type) type `(,type)))
`(,type))))
- ((or (not (eq *boot-state* 'complete))
+ ((or (not (eq **boot-state** 'complete))
(specializerp type))
(specializer-type type))
(t
;;;
;;; FIXME: SB-KERNEL has fast-and-not-quite-precise type code for use
;;; in the compiler. Could we share some of it here?
+(defvar *in-*subtypep* nil)
+
(defun *subtypep (type1 type2)
(if (equal type1 type2)
(values t t)
- (if (eq *boot-state* 'early)
+ (if (eq **boot-state** 'early)
(values (eq type1 type2) t)
- (let ((*in-precompute-effective-methods-p* t))
- (declare (special *in-precompute-effective-methods-p*))
- ;; FIXME: *IN-PRECOMPUTE-EFFECTIVE-METHODS-P* is not a
- ;; good name. It changes the way
- ;; CLASS-APPLICABLE-USING-CLASS-P works.
+ (let ((*in-*subtypep* t))
(setq type1 (*normalize-type type1))
(setq type2 (*normalize-type type2))
(case (car type2)
(push (list class-name symbol) *built-in-wrapper-symbols*)
symbol)))
\f
-(pushnew '%class *var-declarations*)
-(pushnew '%variable-rebinding *var-declarations*)
-
-(defun variable-class (var env)
- (caddr (var-declaration 'class var env)))
-
-(defvar *name->class->slotd-table* (make-hash-table))
-
(defvar *standard-method-combination*)
\f
-(defun make-class-predicate-name (name)
- (list 'class-predicate name))
-
(defun plist-value (object name)
(getf (object-plist object) name))
(let ((subs (classoid-subclasses class)))
(/noshow subs)
(when subs
- (dohash (sub v subs)
+ (dohash ((sub v) subs)
(declare (ignore v))
(/noshow sub)
- (when (member class (direct-supers sub))
+ (when (member class (direct-supers sub) :test #'eq)
(res sub)))))
(res))))
(mapcar (lambda (kernel-bic-entry)
(defclass standard-object (slot-object) ())
-(defclass funcallable-standard-object (standard-object function)
+(defclass funcallable-standard-object (function standard-object)
()
(:metaclass funcallable-standard-class))
-(defclass specializer (standard-object)
- ((type :initform nil :reader specializer-type)))
-
-(defclass definition-source-mixin (standard-object)
- ((source :initform *load-pathname* :reader definition-source
- :initarg :definition-source)))
-
-(defclass plist-mixin (standard-object)
- ((plist :initform () :accessor object-plist)))
+(defclass metaobject (standard-object) ())
-(defclass dependent-update-mixin (plist-mixin) ())
+(defclass generic-function (dependent-update-mixin
+ definition-source-mixin
+ metaobject
+ funcallable-standard-object)
+ ((%documentation
+ :initform nil
+ :initarg :documentation)
+ ;; We need to make a distinction between the methods initially set
+ ;; up by :METHOD options to DEFGENERIC and the ones set up later by
+ ;; DEFMETHOD, because ANSI specifies that executing DEFGENERIC on
+ ;; an already-DEFGENERICed function clears the methods set by the
+ ;; previous DEFGENERIC, but not methods set by DEFMETHOD. (Making
+ ;; this distinction seems a little kludgy, but it has the positive
+ ;; effect of making it so that loading a file a.lisp containing
+ ;; DEFGENERIC, then loading a second file b.lisp containing
+ ;; DEFMETHOD, then modifying and reloading a.lisp and/or b.lisp
+ ;; tends to leave the generic function in a state consistent with
+ ;; the most-recently-loaded state of a.lisp and b.lisp.)
+ (initial-methods
+ :initform ()
+ :accessor generic-function-initial-methods))
+ (:metaclass funcallable-standard-class))
-;;; The class CLASS is a specified basic class. It is the common
-;;; superclass of any kind of class. That is, any class that can be a
-;;; metaclass must have the class CLASS in its class precedence list.
-(defclass class (dependent-update-mixin
- definition-source-mixin
- specializer)
+(defclass standard-generic-function (generic-function)
((name
:initform nil
- :initarg :name
- :accessor class-name)
- (class-eq-specializer
- :initform nil
- :reader class-eq-specializer)
- (direct-superclasses
- :initform ()
- :reader class-direct-superclasses)
- ;; Note: The (CLASS-)DIRECT-SUBCLASSES for STRUCTURE-CLASSes and
- ;; CONDITION-CLASSes are lazily computed whenever the subclass info
- ;; becomes available, i.e. when the PCL class is created.
- (direct-subclasses
+ :initarg :name
+ :reader generic-function-name)
+ (methods
:initform ()
- :reader class-direct-subclasses)
- (direct-methods
- :initform (cons nil nil))
- (predicate-name
- :initform nil
- :reader class-predicate-name)
- (documentation
- :initform nil
- :initarg :documentation)
- (finalized-p
- :initform nil
- :reader class-finalized-p)))
-
-(def!method make-load-form ((class class) &optional env)
- ;; FIXME: should we not instead pass ENV to FIND-CLASS? Probably
- ;; doesn't matter while all our environments are the same...
- (declare (ignore env))
- (let ((name (class-name class)))
- (unless (and name (eq (find-class name nil) class))
- (error "~@<Can't use anonymous or undefined class as constant: ~S~:@>"
- class))
- `(find-class ',name)))
-
-;;; The class PCL-CLASS is an implementation-specific common
-;;; superclass of all specified subclasses of the class CLASS.
-(defclass pcl-class (class)
- ((class-precedence-list
- :reader class-precedence-list)
- ;; KLUDGE: see note in CPL-OR-NIL
- (cpl-available-p
- :reader cpl-available-p
- :initform nil)
- (can-precede-list
+ :accessor generic-function-methods
+ :type list)
+ (method-class
+ :initarg :method-class
+ :accessor generic-function-method-class)
+ (%method-combination
+ :initarg :method-combination
+ :accessor generic-function-method-combination)
+ (declarations
+ ;; KLUDGE: AMOP specifies :DECLARATIONS, while ANSI specifies
+ ;; :DECLARE. Allow either (but FIXME: maybe a note or a warning
+ ;; might be appropriate).
+ :initarg :declarations
+ :initarg :declare
:initform ()
- :reader class-can-precede-list)
- (incompatible-superclass-list
+ :accessor generic-function-declarations)
+ (arg-info
+ :initform (make-arg-info)
+ :reader gf-arg-info)
+ (dfun-state
:initform ()
- :accessor class-incompatible-superclass-list)
- (wrapper
- :initform nil
- :reader class-wrapper)
- (prototype
+ :accessor gf-dfun-state)
+ ;; Used to make DFUN-STATE & FIN-FUNCTION updates atomic.
+ (%lock
+ :initform (sb-thread::make-spinlock :name "GF lock")
+ :reader gf-lock)
+ ;; Set to true by ADD-METHOD, REMOVE-METHOD; to false by
+ ;; MAYBE-UPDATE-INFO-FOR-GF.
+ (info-needs-update
:initform nil
- :reader class-prototype)))
-
-(defclass slot-class (pcl-class)
- ((direct-slots
- :initform ()
- :accessor class-direct-slots)
- (slots
- :initform ()
- :accessor class-slots)))
-
-;;; The class STD-CLASS is an implementation-specific common
-;;; superclass of the classes STANDARD-CLASS and
-;;; FUNCALLABLE-STANDARD-CLASS.
-(defclass std-class (slot-class)
- ())
-
-(defclass standard-class (std-class)
- ())
-
-(defclass funcallable-standard-class (std-class)
- ())
-
-(defclass forward-referenced-class (pcl-class) ())
+ :accessor gf-info-needs-update))
+ (:metaclass funcallable-standard-class)
+ (:default-initargs :method-class *the-class-standard-method*
+ :method-combination *standard-method-combination*))
-(defclass built-in-class (pcl-class) ())
+(defclass method (metaobject) ())
-(defclass condition-class (slot-class) ())
+(defclass standard-method (plist-mixin definition-source-mixin method)
+ ((%generic-function :initform nil :accessor method-generic-function)
+ (qualifiers :initform () :initarg :qualifiers :reader method-qualifiers)
+ (specializers :initform () :initarg :specializers
+ :reader method-specializers)
+ (lambda-list :initform () :initarg :lambda-list :reader method-lambda-list)
+ (%function :initform nil :initarg :function :reader method-function)
+ (%documentation :initform nil :initarg :documentation)))
-(defclass structure-class (slot-class)
- ((defstruct-form
- :initform ()
- :accessor class-defstruct-form)
- (defstruct-constructor
- :initform nil
- :accessor class-defstruct-constructor)
- (from-defclass-p
- :initform nil
- :initarg :from-defclass-p)))
+(defclass accessor-method (standard-method)
+ ((slot-name :initform nil :initarg :slot-name
+ :reader accessor-method-slot-name)))
-(defclass specializer-with-object (specializer) ())
+(defclass standard-accessor-method (accessor-method)
+ ((%slot-definition :initform nil :initarg :slot-definition
+ :reader accessor-method-slot-definition)))
-(defclass exact-class-specializer (specializer) ())
+(defclass standard-reader-method (standard-accessor-method) ())
+(defclass standard-writer-method (standard-accessor-method) ())
+;;; an extension, apparently.
+(defclass standard-boundp-method (standard-accessor-method) ())
-(defclass class-eq-specializer (exact-class-specializer
- specializer-with-object)
- ((object :initarg :class
- :reader specializer-class
- :reader specializer-object)))
+;;; for (SLOT-VALUE X 'FOO) / ACCESSOR-SLOT-VALUE optimization, which
+;;; can't be STANDARD-READER-METHOD because there is no associated
+;;; slot definition.
+(defclass global-reader-method (accessor-method) ())
+(defclass global-writer-method (accessor-method) ())
+(defclass global-boundp-method (accessor-method) ())
-(defclass class-prototype-specializer (specializer-with-object)
- ((object :initarg :class
- :reader specializer-class
- :reader specializer-object)))
+(defclass method-combination (metaobject)
+ ((%documentation :initform nil :initarg :documentation)))
-(defclass eql-specializer (exact-class-specializer specializer-with-object)
- ((object :initarg :object :reader specializer-object
- :reader eql-specializer-object)))
+(defclass standard-method-combination (definition-source-mixin
+ method-combination)
+ ((type-name
+ :reader method-combination-type-name
+ :initarg :type-name)
+ (options
+ :reader method-combination-options
+ :initarg :options)))
-(defvar *eql-specializer-table* (make-hash-table :test 'eql))
+(defclass long-method-combination (standard-method-combination)
+ ((function
+ :initarg :function
+ :reader long-method-combination-function)
+ (args-lambda-list
+ :initarg :args-lambda-list
+ :reader long-method-combination-args-lambda-list)))
-(defun intern-eql-specializer (object)
- (or (gethash object *eql-specializer-table*)
- (setf (gethash object *eql-specializer-table*)
- (make-instance 'eql-specializer :object object))))
-\f
-;;;; slot definitions
+(defclass short-method-combination (standard-method-combination)
+ ((operator
+ :reader short-combination-operator
+ :initarg :operator)
+ (identity-with-one-argument
+ :reader short-combination-identity-with-one-argument
+ :initarg :identity-with-one-argument)))
-(defclass slot-definition (standard-object)
+(defclass slot-definition (metaobject)
((name
:initform nil
:initarg :name
:initform nil
:initarg :initargs
:accessor slot-definition-initargs)
- (type
- :initform t
- :initarg :type
- :accessor slot-definition-type)
- (documentation
- :initform nil
- :initarg :documentation)
- (class
- :initform nil
- :initarg :class
- :accessor slot-definition-class)))
+ (%type :initform t :initarg :type :accessor slot-definition-type)
+ (%documentation
+ :initform nil :initarg :documentation
+ ;; KLUDGE: we need a reader for bootstrapping purposes, in
+ ;; COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS.
+ :reader %slot-definition-documentation)
+ (%class :initform nil :initarg :class :accessor slot-definition-class)))
(defclass standard-slot-definition (slot-definition)
((allocation
())
(defclass effective-slot-definition (slot-definition)
- ((reader-function ; (lambda (object) ...)
- :accessor slot-definition-reader-function)
- (writer-function ; (lambda (new-value object) ...)
- :accessor slot-definition-writer-function)
- (boundp-function ; (lambda (object) ...)
- :accessor slot-definition-boundp-function)
- (accessor-flags
- :initform 0)))
+ ((accessor-flags
+ :initform 0)
+ (info
+ :accessor slot-definition-info)))
+
+;;; We use a structure here, because fast slot-accesses to this information
+;;; are critical to making SLOT-VALUE-USING-CLASS &co fast: places that need
+;;; these functions can access the SLOT-INFO directly, avoiding the overhead
+;;; of accessing a standard-instance.
+(defstruct (slot-info (:constructor make-slot-info
+ (&key slotd
+ typecheck
+ (type t)
+ (reader
+ (uninitialized-accessor-function :reader slotd))
+ (writer
+ (uninitialized-accessor-function :writer slotd))
+ (boundp
+ (uninitialized-accessor-function :boundp slotd)))))
+ (typecheck nil :type (or null function))
+ (reader (missing-arg) :type function)
+ (writer (missing-arg) :type function)
+ (boundp (missing-arg) :type function))
(defclass standard-direct-slot-definition (standard-slot-definition
direct-slot-definition)
effective-slot-definition)
())
-(defclass method (standard-object) ())
+(defclass specializer (metaobject)
+ ;; KLUDGE: in sbcl-0.9.10.2 this was renamed from TYPE, which was an
+ ;; external symbol of the CL package and hence potentially collides
+ ;; with user code. Renaming this to %TYPE, however, is the coward's
+ ;; way out, because the objects that PCL puts in this slot aren't
+ ;; (quite) types: they are closer to kinds of specializer. However,
+ ;; the wholesale renaming and disentangling of specializers didn't
+ ;; appeal. (See also message <sqd5hrclb2.fsf@cam.ac.uk> and
+ ;; responses in comp.lang.lisp). -- CSR, 2006-02-27
+ ((%type :initform nil :reader specializer-type)))
+
+;;; STANDARD in this name doesn't mean "blessed by a standard" but
+;;; "comes as standard with PCL"; that is, it includes CLASS-EQ
+;;; and vestiges of PROTOTYPE specializers
+(defclass standard-specializer (specializer) ())
-(defclass standard-method (definition-source-mixin plist-mixin method)
- ((generic-function
- :initform nil
- :accessor method-generic-function)
-;;; (qualifiers
-;;; :initform ()
-;;; :initarg :qualifiers
-;;; :reader method-qualifiers)
- (specializers
- :initform ()
- :initarg :specializers
- :reader method-specializers)
- (lambda-list
- :initform ()
- :initarg :lambda-list
- :reader method-lambda-list)
- (function
- :initform nil
- :initarg :function) ;no writer
- (fast-function
- :initform nil
- :initarg :fast-function ;no writer
- :reader method-fast-function)
- (documentation
- :initform nil
- :initarg :documentation)))
+(defclass specializer-with-object (specializer) ())
-(defclass standard-accessor-method (standard-method)
- ((slot-name :initform nil
- :initarg :slot-name
- :reader accessor-method-slot-name)
- (slot-definition :initform nil
- :initarg :slot-definition
- :reader accessor-method-slot-definition)))
+(defclass exact-class-specializer (specializer) ())
-(defclass standard-reader-method (standard-accessor-method) ())
+(defclass class-eq-specializer (standard-specializer
+ exact-class-specializer
+ specializer-with-object)
+ ((object :initarg :class
+ :reader specializer-class
+ :reader specializer-object)))
-(defclass standard-writer-method (standard-accessor-method) ())
+(defclass class-prototype-specializer (standard-specializer specializer-with-object)
+ ((object :initarg :class
+ :reader specializer-class
+ :reader specializer-object)))
-(defclass standard-boundp-method (standard-accessor-method) ())
+(defclass eql-specializer (standard-specializer exact-class-specializer specializer-with-object)
+ ((object :initarg :object :reader specializer-object
+ :reader eql-specializer-object)))
-(defclass generic-function (dependent-update-mixin
- definition-source-mixin
- funcallable-standard-object)
- ((documentation
- :initform nil
- :initarg :documentation)
- ;; We need to make a distinction between the methods initially set
- ;; up by :METHOD options to DEFGENERIC and the ones set up later by
- ;; DEFMETHOD, because ANSI specifies that executing DEFGENERIC on
- ;; an already-DEFGENERICed function clears the methods set by the
- ;; previous DEFGENERIC, but not methods set by DEFMETHOD. (Making
- ;; this distinction seems a little kludgy, but it has the positive
- ;; effect of making it so that loading a file a.lisp containing
- ;; DEFGENERIC, then loading a second file b.lisp containing
- ;; DEFMETHOD, then modifying and reloading a.lisp and/or b.lisp
- ;; tends to leave the generic function in a state consistent with
- ;; the most-recently-loaded state of a.lisp and b.lisp.)
- (initial-methods
- :initform ()
- :accessor generic-function-initial-methods))
- (:metaclass funcallable-standard-class))
+(defvar *eql-specializer-table* (make-hash-table :test 'eql))
-(defclass standard-generic-function (generic-function)
+(defvar *eql-specializer-table-lock*
+ (sb-thread::make-spinlock :name "EQL-specializer table lock"))
+
+(defun intern-eql-specializer (object)
+ ;; Need to lock, so that two threads don't get non-EQ specializers
+ ;; for an EQL object.
+ (sb-thread::with-spinlock (*eql-specializer-table-lock*)
+ (or (gethash object *eql-specializer-table*)
+ (setf (gethash object *eql-specializer-table*)
+ (make-instance 'eql-specializer :object object)))))
+
+(defclass class (dependent-update-mixin
+ definition-source-mixin
+ standard-specializer)
((name
:initform nil
:initarg :name
- :accessor generic-function-name)
- (methods
+ :reader class-name)
+ (class-eq-specializer
+ :initform nil
+ :reader class-eq-specializer)
+ (direct-superclasses
:initform ()
- :accessor generic-function-methods
- :type list)
- (method-class
- :initarg :method-class
- :accessor generic-function-method-class)
- (method-combination
- :initarg :method-combination
- :accessor generic-function-method-combination)
- (declarations
- ;; KLUDGE: AMOP specifies :DECLARATIONS, while ANSI specifies
- ;; :DECLARE. Allow either (but FIXME: maybe a note or a warning
- ;; might be appropriate).
- :initarg :declarations
- :initarg :declare
+ :reader class-direct-superclasses)
+ ;; Note: The (CLASS-)DIRECT-SUBCLASSES for STRUCTURE-CLASSes and
+ ;; CONDITION-CLASSes are lazily computed whenever the subclass info
+ ;; becomes available, i.e. when the PCL class is created.
+ (direct-subclasses
:initform ()
- :accessor generic-function-declarations)
- (arg-info
- :initform (make-arg-info)
- :reader gf-arg-info)
- (dfun-state
+ :reader class-direct-subclasses)
+ (direct-methods
+ :initform (cons nil nil))
+ (%documentation
+ :initform nil
+ :initarg :documentation)
+ ;; True if the class definition was compiled with a (SAFETY 3)
+ ;; optimization policy.
+ (safe-p
+ :initform nil
+ :initarg safe-p
+ :accessor safe-p)
+ (finalized-p
+ :initform nil
+ :reader class-finalized-p)))
+
+(def!method make-load-form ((class class) &optional env)
+ ;; FIXME: should we not instead pass ENV to FIND-CLASS? Probably
+ ;; doesn't matter while all our environments are the same...
+ (declare (ignore env))
+ (let ((name (class-name class)))
+ (unless (and name (eq (find-class name nil) class))
+ (error "~@<Can't use anonymous or undefined class as constant: ~S~:@>"
+ class))
+ `(find-class ',name)))
+
+;;; The class PCL-CLASS is an implementation-specific common
+;;; superclass of all specified subclasses of the class CLASS.
+(defclass pcl-class (class)
+ ((%class-precedence-list
+ :reader class-precedence-list)
+ ;; KLUDGE: see note in CPL-OR-NIL
+ (cpl-available-p
+ :reader cpl-available-p
+ :initform nil)
+ (can-precede-list
:initform ()
- :accessor gf-dfun-state))
- (:metaclass funcallable-standard-class)
- (:default-initargs :method-class *the-class-standard-method*
- :method-combination *standard-method-combination*))
+ :reader class-can-precede-list)
+ (incompatible-superclass-list
+ :initform ()
+ :accessor class-incompatible-superclass-list)
+ (wrapper
+ :initform nil
+ :reader class-wrapper)
+ (prototype
+ :initform nil
+ :reader class-prototype)))
+
+(defclass slot-class (pcl-class)
+ ((direct-slots
+ :initform ()
+ :reader class-direct-slots)
+ (slots
+ :initform ()
+ :reader class-slots)))
+
+;;; The class STD-CLASS is an implementation-specific common
+;;; superclass of the classes STANDARD-CLASS and
+;;; FUNCALLABLE-STANDARD-CLASS.
+(defclass std-class (slot-class)
+ ())
+
+(defclass standard-class (std-class)
+ ()
+ (:default-initargs
+ :direct-superclasses (list *the-class-standard-object*)))
+
+(defclass funcallable-standard-class (std-class)
+ ()
+ (:default-initargs
+ :direct-superclasses (list *the-class-funcallable-standard-object*)))
+
+(defclass forward-referenced-class (pcl-class) ())
+
+(defclass built-in-class (pcl-class) ())
-(defclass method-combination (standard-object)
- ((documentation
- :reader method-combination-documentation
+(defclass condition-class (slot-class) ())
+
+(defclass structure-class (slot-class)
+ ((defstruct-form :initform () :accessor class-defstruct-form)
+ (defstruct-constructor :initform nil :accessor class-defstruct-constructor)
+ (from-defclass-p :initform nil :initarg :from-defclass-p)))
+
+(defclass definition-source-mixin (standard-object)
+ ((source
:initform nil
- :initarg :documentation)))
+ :reader definition-source
+ :initarg :definition-source)))
-(defclass standard-method-combination (definition-source-mixin
- method-combination)
- ((type
- :reader method-combination-type
- :initarg :type)
- (options
- :reader method-combination-options
- :initarg :options)))
+(defclass plist-mixin (standard-object)
+ ((plist :initform () :accessor object-plist :initarg plist)))
-(defclass long-method-combination (standard-method-combination)
- ((function
- :initarg :function
- :reader long-method-combination-function)
- (args-lambda-list
- :initarg :args-lambda-list
- :reader long-method-combination-args-lambda-list)))
+(defclass dependent-update-mixin (plist-mixin) ())
(defparameter *early-class-predicates*
'((specializer specializerp)
+ (standard-specializer standard-specializer-p)
(exact-class-specializer exact-class-specializer-p)
(class-eq-specializer class-eq-specializer-p)
(eql-specializer eql-specializer-p)
(forward-referenced-class forward-referenced-class-p)
(method method-p)
(standard-method standard-method-p)
+ (accessor-method accessor-method-p)
(standard-accessor-method standard-accessor-method-p)
(standard-reader-method standard-reader-method-p)
(standard-writer-method standard-writer-method-p)
(standard-boundp-method standard-boundp-method-p)
+ (global-reader-method global-reader-method-p)
+ (global-writer-method global-writer-method-p)
+ (global-boundp-method global-boundp-method-p)
(generic-function generic-function-p)
(standard-generic-function standard-generic-function-p)
(method-combination method-combination-p)
- (long-method-combination long-method-combination-p)))
-
+ (long-method-combination long-method-combination-p)
+ (short-method-combination short-method-combination-p)))