ECL now uses and updates the DIRECT-METHODS and DIRECT-GENERIC-FUNCTIONS in specializer objects

src/CHANGELOG

@@ -56,6 +56,11 @@ ECL 12.2.2:
 
  - Implemented the class CLOS:METAOBJECT
 
+ - Implemented SPECIALIZER and EQL-SPECIALIZER, together with
+   ADD-DIRECT-METHOD, REMOVE-DIRECT-METHOD, SPECIALIZER-DIRECT-METHODS,
+   SPECIALIZER-DIRECT-GENERIC-FUNCTIONS and EQL-SPECIALIZER-OBJECT. ECL now
+   uses these objects internally for method dispatch.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***

src/clos/fixup.lsp

@@ -80,7 +80,13 @@
 ;;; ----------------------------------------------------------------------
 ;;; Fixup
 
-(dolist (method-info *early-methods*)
+
+(defun register-method-with-specializers (method)
+  (declare (si::c-local))
+  (loop for spec in (method-specializers method)
+     do (add-direct-method spec method)))
+
+(dolist (method-info *early-methods* (makunbound '*EARLY-METHODS*))
   (let* ((method-name (car method-info))
 	 (gfun (fdefinition method-name))
 	 (standard-method-class (find-class 'standard-method)))
@@ -102,8 +108,9 @@
 				      (t
 				       old-class))))
       (si::instance-sig-set gfun)
+      (register-method-with-specializers method)
       )
-    (makunbound '*EARLY-METHODS*)))
+    ))
 
 
 ;;; ----------------------------------------------------------------------
@@ -202,7 +209,8 @@ their lambda lists ~A and ~A are not congruent."
   (set-generic-function-dispatch gf)
   ;;  iv) Update dependents.
   (update-dependents gf (list 'add-method method))
-  ;;
+  ;;  v) Register with specializers
+  (register-method-with-specializers method)
   gf)
 
 (defun function-to-method (name signature)
@@ -219,6 +227,8 @@ their lambda lists ~A and ~A are not congruent."
 	(delete method (generic-function-methods gf))
 	(method-generic-function method) nil)
   (si:clear-gfun-hash gf)
+  (loop for spec in (method-specializers method)
+     do (add-direct-method spec method))
   (update-dependents gf (list 'remove-method method))
   gf)
 

src/clos/stdmethod.lsp

@@ -89,3 +89,25 @@
       (or (gethash object table nil)
 	  (setf (gethash object table)
 		(make-instance 'eql-specializer :object object))))))
+
+(defmethod add-direct-method ((spec specializer) (method method))
+  (pushnew method (specializer-direct-methods spec))
+  (let ((gf (method-generic-function method)))
+    (pushnew gf (specializer-direct-generic-functions spec)))
+  (values))
+
+(defmethod remove-direct-method ((spec specializer) (method method))
+  (let* ((gf (method-generic-function method))
+	 (methods (delete method (specializer-direct-methods spec))))
+    (setf (specializer-direct-methods spec) methods)
+    (unless (find gf methods :key #'method-generic-function)
+      (setf (specializer-direct-generic-functions spec)
+	    (delete gf (specializer-direct-generic-functions spec))))
+    (values)))
+
+(defmethod remove-direct-method ((spec eql-specializer) (method method))
+  (mp:with-lock (*eql-specializer-lock*)
+    (call-next-method)
+    (unless (specializer-direct-methods spec)
+      (remhash spec *eql-specializer-hash*)))
+  (values))