From: Christophe Rhodes Date: Sat, 24 May 2014 19:01:15 +0000 (+0100) Subject: just-about support first-arg-only-special-case in pattern specializers X-Git-Url: http://christophe.rhodes.io/gitweb/?a=commitdiff_plain;h=refs%2Fheads%2Fpattern-specializers;p=specializable.git 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 a3593e8..6084ea6 100644 --- 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))