just-about support first-arg-only-special-case in pattern specializers

diff --git a/src/pattern-specializer/pattern-specializer.lisp b/src/pattern-specializer/pattern-specializer.lisp
index a3593e8c537b9d4c98de05729acfb1371360c0b3..6084ea652cb657c54ec2c96567fa11cf91cf305b 100644 (file)
--- a/src/pattern-specializer/pattern-specializer.lisp
+++ b/src/pattern-specializer/pattern-specializer.lisp
@@ -350,6 +350,14 @@
          ((not nexts) (first (setf nexts (nthcdr i (call-next-method)))))
          (t           (first  nexts))))))
 
+(defmethod specializable:generalizer-of-using-class ((generic-function pattern-generic-function) args)
+  ;; TODO: this is a hack -- the main specializer protocol calls the
+  ;; singular generalizer-of-using-class when there's only one
+  ;; specialized arg, to save on wasted effort.  We can just about
+  ;; support it here, but it's very brittle.
+  (assert (specializable::first-arg-only-special-case generic-function))
+  (car (specializable:generalizers-of-using-class generic-function (list args))))
+
 ;;; Specializer clustering
 
 (defmethod in-same-cluster-p ((generic-function t) (specializer1 t) (specializer2 t))