(:export "SPECIALIZABLE-GENERIC-FUNCTION" "SPECIALIZABLE-METHOD"
"EXTENDED-SPECIALIZER"
- "SPECIALIZER-ACCEPTS-P" "SPECIALIZER-ACCEPTS-CLASS-P"
+ "SPECIALIZER-ACCEPTS-P" "SPECIALIZER-ACCEPTS-GENERALIZER-P"
"SPECIALIZER<"
"GENERALIZER-OF-USING-CLASS"
;;; FIXME: in some kind of order, the discriminating function needs to handle:
;;; - argument count checking;
;;; - keyword argument validity;
-;;; - flushing the emf cache on method addition/removal
+;;; - DONE flushing the emf cache on method addition/removal
;;; - flushing the cache on class redefinition;
;;; - cache thread-safety.
(defmethod sb-mop:compute-discriminating-function ((gf specializable-generic-function))
(sb-pcl::invoke-emf emfun args)
(slow-method-lookup gf args generalizers)))))
+(defmethod reinitialize-instance :after ((gf specializable-generic-function) &key)
+ (clrhash (emf-table gf)))
+
(defun slow-method-lookup (gf args generalizers)
;; differs from closette
(multiple-value-bind (applicable-methods definitivep)
(defmethod generalizer-of-using-class ((generic-function specializable-generic-function) object)
(class-of object))
-(defgeneric specializer-accepts-generalizer-p (specializer generalizer))
-(defmethod specializer-accepts-generalizer-p ((specializer class) (generalizer class))
- ;; does the specializer's object have the -same- class as the the actual
- ;; argument?
+(defgeneric specializer-accepts-generalizer-p (gf specializer generalizer))
+(defmethod specializer-accepts-generalizer-p
+ ((gf specializable-generic-function) (specializer class) (generalizer class))
(if (subtypep generalizer specializer)
- ;; definitive: this method matches all instances of this class
(values t t)
- ;; definitive: this method doesn't match instances of this class
(values nil t)))
(defmethod specializer-accepts-generalizer-p
- ((specializer sb-mop:eql-specializer) (generalizer class))
- ;; does the specializer's object have the -same- class as the actual
- ;; argument?
+ ((gf specializable-generic-function) (specializer sb-mop:eql-specializer) (generalizer class))
(if (eq generalizer (class-of (sb-mop:eql-specializer-object specializer)))
- ;; not definitive, since the actual object might differ
(values t nil)
- ;; definitely not the same object
(values nil t)))
(defgeneric compute-applicable-methods-using-generalizers (gf generalizers))
(flet ((filter (method)
(every (lambda (s g)
(multiple-value-bind (acceptsp definitivep)
- (specializer-accepts-generalizer-p s g)
+ (specializer-accepts-generalizer-p gf s g)
(unless definitivep
(setf result-definitive-p nil))
acceptsp))
(method-more-specific-p gf m1 m2 generalizers)))))
(defun method-more-specific-p (gf method1 method2 generalizers)
- ;; differs from closette
- (declare (ignore gf))
;; FIXME: argument precedence order
(block nil
(mapc #'(lambda (spec1 spec2 generalizer)
- (ecase (specializer< spec1 spec2 generalizer)
+ (ecase (specializer< gf spec1 spec2 generalizer)
(< (return t))
(=)
((nil > /=) (return nil))))
nil))
;; new, not in closette
-(defgeneric specializer< (s1 s2 generalizer))
-(defmethod specializer< ((s1 class) (s2 class) (generalizer class))
+(defgeneric specializer< (gf s1 s2 generalizer))
+(defmethod specializer<
+ ((gf specializable-generic-function) (s1 class) (s2 class) (generalizer class))
(if (eq s1 s2)
'=
(let ((cpl (sb-mop:class-precedence-list generalizer)))
'<
nil))))
(defmethod specializer<
- ((s1 sb-mop:eql-specializer) (s2 sb-mop:eql-specializer) generalizer)
+ ((gf specializable-generic-function) (s1 sb-mop:eql-specializer) (s2 sb-mop:eql-specializer) generalizer)
(declare (ignore generalizer))
(if (eq (sb-mop:eql-specializer-object s1) (sb-mop:eql-specializer-object s2))
'=
nil))
-(defmethod specializer< ((s1 sb-mop:eql-specializer) (s2 class) generalizer)
+(defmethod specializer< ((gf specializable-generic-function) (s1 sb-mop:eql-specializer) (s2 class) generalizer)
(declare (ignore generalizer))
'<)
-(defmethod specializer< ((c1 class) (c2 sb-mop:eql-specializer) generalizer)
+(defmethod specializer< ((gf specializable-generic-function) (c1 class) (c2 sb-mop:eql-specializer) generalizer)
(declare (ignore generalizer))
'>)