1.0.6.12: Improve user-subclassed SB-MOP:SPECIALIZER support

[sbcl.git] / src / pcl / defs.lisp

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 68e53b6..3bf72db 100644 (file)
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -62,11 +62,12 @@
 
 ;;; 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))))
@@ -304,7 +305,7 @@
 
 (defclass standard-object (slot-object) ())
 
-(defclass funcallable-standard-object (standard-object function)
+(defclass funcallable-standard-object (function standard-object)
   ()
   (:metaclass funcallable-standard-class))
 
@@ -314,7 +315,9 @@
                             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
@@ -326,8 +329,9 @@
    ;; 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)
@@ -358,7 +362,11 @@
     :reader gf-arg-info)
    (dfun-state
     :initform ()
-    :accessor gf-dfun-state))
+    :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))
   (:metaclass funcallable-standard-class)
   (:default-initargs :method-class *the-class-standard-method*
                      :method-combination *standard-method-combination*))
@@ -366,21 +374,11 @@
 (defclass method (metaobject) ())
 
 (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)
+  ((%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)))
 
@@ -458,6 +456,9 @@
     :initarg :initargs
     :accessor slot-definition-initargs)
    (%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
@@ -599,6 +600,12 @@
    (%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)))