1.0.2:
[sbcl.git] / src / pcl / defs.lisp
index 03ac566..607f6c5 100644 (file)
 (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))
 
 
 (defclass standard-object (slot-object) ())
 
-(defclass funcallable-standard-object (standard-object function)
+(defclass funcallable-standard-object (function standard-object)
   ()
   (:metaclass funcallable-standard-class))
 
                             definition-source-mixin
                             metaobject
                             funcallable-standard-object)
-  ((documentation
-    :initform nil
-    :initarg :documentation)
+  ((%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
    ;; 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))
+   (initial-methods :initform ()
+                    :accessor generic-function-initial-methods))
   (:metaclass funcallable-standard-class))
 
 (defclass standard-generic-function (generic-function)
    (method-class
     :initarg :method-class
     :accessor generic-function-method-class)
-   (method-combination
+   (%method-combination
     :initarg :method-combination
     :accessor generic-function-method-combination)
    (declarations
 
 (defclass method (metaobject) ())
 
-(defclass standard-method (definition-source-mixin plist-mixin method)
-  ((generic-function
+(defclass standard-method (plist-mixin definition-source-mixin method)
+  ((%generic-function
     :initform nil
     :accessor method-generic-function)
-;;;     (qualifiers
-;;;     :initform ()
-;;;     :initarg  :qualifiers
-;;;     :reader method-qualifiers)
+   (qualifiers
+    :initform ()
+    :initarg  :qualifiers
+    :reader method-qualifiers)
    (specializers
     :initform ()
     :initarg  :specializers
     :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)))
+   (%function :initform nil :initarg :function :reader method-function)
+   (%documentation :initform nil :initarg :documentation)))
+
+(defclass accessor-method (standard-method)
+  ((slot-name :initform nil :initarg :slot-name
+              :reader accessor-method-slot-name)))
 
-(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 standard-accessor-method (accessor-method)
+  ((%slot-definition :initform nil :initarg :slot-definition
+                     :reader accessor-method-slot-definition)))
 
 (defclass standard-reader-method (standard-accessor-method) ())
 (defclass standard-writer-method (standard-accessor-method) ())
 ;;; an extension, apparently.
 (defclass standard-boundp-method (standard-accessor-method) ())
 
+;;; 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 method-combination (metaobject)
-  ((documentation
-    :reader method-combination-documentation
-    :initform nil
-    :initarg :documentation)))
+  ((%documentation :initform nil :initarg :documentation)))
 
 (defclass standard-method-combination (definition-source-mixin
                                        method-combination)
-  ((type
-    :reader method-combination-type
-    :initarg :type)
+  ((type-name
+    :reader method-combination-type-name
+    :initarg :type-name)
    (options
     :reader method-combination-options
     :initarg :options)))
     :initarg :args-lambda-list
     :reader long-method-combination-args-lambda-list)))
 
+(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 (metaobject)
   ((name
     :initform nil
     :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)
+   (%type-check-function :initform nil
+                         :initarg type-check-function
+                         :accessor slot-definition-type-check-function)
+   (%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 specializer (metaobject)
-  ((type :initform nil :reader specializer-type)))
+  ;; 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)))
 
 (defclass specializer-with-object (specializer) ())
 
     :reader class-direct-subclasses)
    (direct-methods
     :initform (cons nil nil))
-   (predicate-name
-    :initform nil
-    :reader class-predicate-name)
-   (documentation
+   (%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)))
 ;;; 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
+  ((%class-precedence-list
     :reader class-precedence-list)
    ;; KLUDGE: see note in CPL-OR-NIL
    (cpl-available-p
     :initarg :definition-source)))
 
 (defclass plist-mixin (standard-object)
-  ((plist :initform () :accessor object-plist)))
+  ((plist :initform () :accessor object-plist :initarg plist)))
 
 (defclass dependent-update-mixin (plist-mixin) ())
 
     (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)))