From 7d853ed1882221bc790062e423a74a620f6e4ee1 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cantab.net>
Date: Mon, 11 Jun 2007 13:47:38 +0000
Subject: [PATCH] 1.0.6.46: better standard-specializer-p implementation 
 Instead of defining a gf with several methods, define a new
 	class STANDARD-SPECIALIZER to be used as a
 superclass to the 	various specializers that are
 handled internally in PCL.

	It's not exported, because we don't want people to subclass it:
	they will not be able to implement the relevant protocols.
---
 src/pcl/cache.lisp   |    3 ++-
 src/pcl/defs.lisp    |   15 +++++++++++----
 src/pcl/methods.lisp |   14 --------------
 version.lisp-expr    |    2 +-
 4 files changed, 14 insertions(+), 20 deletions(-)

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index c559b61..d6afcc0 100644
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -81,7 +81,8 @@
   ;;   (mod index (length vector))
   ;; using a bitmask.
   (vector #() :type simple-vector)
-  ;; The bitmask used to calculate (mod (* line-size line-hash) (length vector))).
+  ;; The bitmask used to calculate
+  ;;   (mod (* line-size line-hash) (length vector))).
   (mask 0 :type fixnum)
   ;; Current probe-depth needed in the cache.
   (depth 0 :type index)
diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 882a37f..703a7b5 100644
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -550,22 +550,28 @@
   ;; 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 specializer-with-object (specializer) ())
 
 (defclass exact-class-specializer (specializer) ())
 
-(defclass class-eq-specializer (exact-class-specializer
+(defclass class-eq-specializer (standard-specializer
+                                exact-class-specializer
                                 specializer-with-object)
   ((object :initarg :class
            :reader specializer-class
            :reader specializer-object)))
 
-(defclass class-prototype-specializer (specializer-with-object)
+(defclass class-prototype-specializer (standard-specializer specializer-with-object)
   ((object :initarg :class
            :reader specializer-class
            :reader specializer-object)))
 
-(defclass eql-specializer (exact-class-specializer specializer-with-object)
+(defclass eql-specializer (standard-specializer exact-class-specializer specializer-with-object)
   ((object :initarg :object :reader specializer-object
            :reader eql-specializer-object)))
 
@@ -584,7 +590,7 @@
 
 (defclass class (dependent-update-mixin
                  definition-source-mixin
-                 specializer)
+                 standard-specializer)
   ((name
     :initform nil
     :initarg :name
@@ -698,6 +704,7 @@
 
 (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)
diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index f203810..c6fee7d 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -640,20 +640,6 @@
 (defmethod specializer-class ((specializer eql-specializer))
   (class-of (slot-value specializer 'object)))
 
-;;; KLUDGE: this is needed to allow for user-defined specializers in
-;;; RAISE-METATYPE; however, the list of methods is maintained by
-;;; hand, which is error-prone.  We can't just add a method to
-;;; SPECIALIZER-CLASS, or at least not with confidence, as that
-;;; function is used elsewhere in PCL.  `STANDARD' here is used in the
-;;; sense of `comes with PCL' rather than `blessed by the
-;;; authorities'.  -- CSR, 2007-05-10
-(defmethod standard-specializer-p ((specializer class)) t)
-(defmethod standard-specializer-p ((specializer eql-specializer)) t)
-(defmethod standard-specializer-p ((specializer class-eq-specializer)) t)
-(defmethod standard-specializer-p ((specializer class-prototype-specializer))
-  t)
-(defmethod standard-specializer-p ((specializer specializer)) nil)
-
 (defun specializer-class-or-nil (specializer)
   (and (standard-specializer-p specializer)
        (specializer-class specializer)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 549510d..a6682f8 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.6.45"
+"1.0.6.46"
-- 
1.7.10.4