delete stale add/remove-direct-method comment

[specializable.git] / specializable.lisp

diff --git a/specializable.lisp b/specializable.lisp
index c69f78606ee0cdfa6e45d4295b4e0f7fa1b701aa..b74d73fdd506347aa61dd14de4b71f94ecbfe70e 100644 (file)
--- a/specializable.lisp
+++ b/specializable.lisp
@@ -20,9 +20,27 @@
 (in-package "SPECIALIZABLE")
 
 (defclass extended-specializer (sb-mop:specializer)
-  ((direct-methods :initform nil
-                   :accessor %specializer-direct-methods
-                   :reader specializer-direct-methods)))
+  ((direct-methods-table :allocation :class
+                         :initform nil :accessor direct-methods-table)))
+
+(defmethod sb-mop:add-direct-method ((specializer extended-specializer) method)
+  (let* ((table (direct-methods-table specializer))
+         (cell (assoc specializer table :test #'sb-pcl::same-specializer-p)))
+    (unless cell
+      (setf cell (cons specializer nil))
+      (push cell (direct-methods-table specializer)))
+    (push method (cdr cell))))
+
+(defmethod sb-mop:remove-direct-method ((specializer extended-specializer) method)
+  (let* ((table (direct-methods-table specializer))
+         (cell (assoc specializer table :test #'sb-pcl::same-specializer-p)))
+    (setf (cdr cell) (remove method (cdr cell)))))
+
+(defmethod sb-mop:specializer-direct-methods ((specializer extended-specializer))
+  (cdr (assoc specializer (direct-methods-table specializer)
+              :test #'sb-pcl::same-specializer-p)))
+(defmethod sb-mop:specializer-direct-generic-functions ((specializer extended-specializer))
+  (remove-duplicates (mapcar #'sb-mop:method-generic-function (sb-mop:specializer-direct-methods specializer))))
 
 (defclass specializable-generic-function (standard-generic-function)
   ((extended-specializers :initform (make-hash-table :test 'equal)
@@ -52,12 +70,6 @@
 ;;;             gf
 ;;;             args))))
 
-;;; FIXME: this (and add/remove-direct-method) don't actually work
-;;; together, because two distinct calls to make-extended-specializer
-;;; return two distinct specializer objects.  We need either to make
-;;; the extended specializers be interned, or to have them be
-;;; arbitrarily ephemeral but adjust specializer-direct-methods (and
-;;; implement specializer-direct-generic-functions) accordingly.
 (defun make-extended-specializer (sname)
   (destructuring-bind (kind &rest args) sname
     (apply (or (get kind 'extended-specializer-parser)
@@ -66,13 +78,6 @@
           '|This is not a generic function| ;fixme, see comment above
           args)))
 
-(defmethod sb-mop:add-direct-method ((specializer extended-specializer) method)
-  (pushnew method (%specializer-direct-methods specializer)))
-
-(defmethod sb-mop:remove-direct-method ((specializer extended-specializer) method)
-  (setf (%specializer-direct-methods specializer)
-        (remove method (specializer-direct-methods specializer))))
-
 ;;; from SBCL:
 
 (defmethod sb-pcl:parse-specializer-using-class