added dumb mechanism for extra args in generalizers

diff --git a/src/specializable.lisp b/src/specializable.lisp
index 02e8f18f03b567b63fa20c92727d78292842fbd4..7da310443e38b4b62bb5fc1513b4f94e3763c039 100644 (file)
--- a/src/specializable.lisp
+++ b/src/specializable.lisp
@@ -116,6 +116,11 @@
     ((gf specializable-generic-function) (g class))
   (sb-pcl::class-wrapper g))
 
+(defgeneric generalizer-args (generic-function generalizer))  ; TODO add a subclass of specializable generic-function for this?
+(defmethod generalizer-args ((generic-function specializable-generic-function)
+                             (generalizer t))
+  '())
+
 (defun first-arg-only-special-case (gf)
   (let ((arg-info (sb-pcl::gf-arg-info gf)))
     (and (slot-value gf 'single-arg-cacheing-p)
@@ -141,21 +146,26 @@
      (lambda (&rest args)
        (let* ((generalizer (generalizer-of-using-class gf (first args)))
               (key (generalizer-equal-hash-key gf generalizer))
+              (extra-args (generalizer-args gf generalizer))
               (emfun (gethash key (emf-table gf) nil)))
          (if emfun
-             (sb-pcl::invoke-emf emfun args)
+             (sb-pcl::invoke-emf emfun (append args extra-args)) ; TODO conses
              (slow-method-lookup-and-call
-              gf args (list* generalizer
-                             (mapcar (lambda (x) (generalizer-of-using-class gf x))
-                                     (rest (required-portion gf args)))))))))
+              gf (append args extra-args)
+              (list* generalizer
+                     (mapcar (lambda (x) (generalizer-of-using-class gf x))
+                             (rest (required-portion gf args)))))))))
     (t
      (lambda (&rest args)
        (let* ((generalizers (generalizers-of-using-class gf args))
               (keys (mapcar (lambda (x) (generalizer-equal-hash-key gf x)) generalizers))
+              (extra-args (mapcan (lambda (x) (generalizer-args gf x)) generalizers)) ; TODO destructive?
               (emfun (gethash keys (emf-table gf) nil)))
          (if emfun
-             (sb-pcl::invoke-emf emfun args)
-             (slow-method-lookup-and-call gf args generalizers)))))))
+             (sb-pcl::invoke-emf emfun (append args extra-args)) ; TODO conses
+             (slow-method-lookup-and-call
+              gf (append args extra-args)
+              generalizers)))))))
 
 (defmethod reinitialize-instance :after ((gf specializable-generic-function) &key)
   (clrhash (emf-table gf)))