From 0a3dabdf09f8b1e39324a8228d0073d801669410 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 24 May 2014 20:01:15 +0100 Subject: [PATCH] just-about support first-arg-only-special-case in pattern specializers --- src/pattern-specializer/pattern-specializer.lisp | 8 ++++++++ 1 file changed, 8 insertions(+) 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)) -- 2.39.5