From 10e470a1cb09d5a30ba370be445974634c549da0 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 20 Dec 2013 18:55:02 +0000 Subject: [PATCH] get SPECIALIZER-DIRECT-METHODS (and -GENERIC-FUNCTIONS) right we can do what we need by having SB-MOP:ADD-DIRECT-METHODS and SB-MOP:REMOVE-DIRECT-METHODS maintain a per-class table, indexed by the specializers under SB-PCL::SAME-SPECIALIZER-P, of direct methods. This then is agnostic to whether the specializers are interned or freshly generated. --- specializable.lisp | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/specializable.lisp b/specializable.lisp index c69f786..d1bd688 100644 --- 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) @@ -66,13 +84,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 -- 2.30.2