X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fmethods.lisp;h=c6fee7d8a62bb673722cb83f59337544fb3d961f;hb=6e953f60d904a015b3273db84b5886b04a9ecb1c;hp=36fb2c036d5cf81616ccca1a4749f4269f436b69;hpb=617d4fa1db5a4a11564e7c59bfb684c7eb25633d;p=sbcl.git diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 36fb2c0..c6fee7d 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -640,20 +640,6 @@ (defmethod specializer-class ((specializer eql-specializer)) (class-of (slot-value specializer 'object))) -;;; KLUDGE: this is needed to allow for user-defined specializers in -;;; RAISE-METATYPE; however, the list of methods is maintained by -;;; hand, which is error-prone. We can't just add a method to -;;; SPECIALIZER-CLASS, or at least not with confidence, as that -;;; function is used elsewhere in PCL. `STANDARD' here is used in the -;;; sense of `comes with PCL' rather than `blessed by the -;;; authorities'. -- CSR, 2007-05-10 -(defmethod standard-specializer-p ((specializer class)) t) -(defmethod standard-specializer-p ((specializer eql-specializer)) t) -(defmethod standard-specializer-p ((specializer class-eq-specializer)) t) -(defmethod standard-specializer-p ((specializer class-prototype-specializer)) - t) -(defmethod standard-specializer-p ((specializer specializer)) nil) - (defun specializer-class-or-nil (specializer) (and (standard-specializer-p specializer) (specializer-class specializer))) @@ -1514,7 +1500,7 @@ (eq gf #'slot-boundp-using-class))) (defmethod compute-discriminating-function ((gf standard-generic-function)) - (with-slots (dfun-state arg-info) gf + (let ((dfun-state (slot-value gf 'dfun-state))) (when (special-case-for-compute-discriminating-function-p gf) ;; if we have a special case for ;; COMPUTE-DISCRIMINATING-FUNCTION, then (at least for the @@ -1535,7 +1521,7 @@ ((eq gf #'slot-boundp-using-class) (update-slot-value-gf-info gf 'boundp) #'slot-boundp-using-class-dfun) - ((gf-precompute-dfun-and-emf-p arg-info) + ((gf-precompute-dfun-and-emf-p (slot-value gf 'arg-info)) (make-final-dfun gf)) (t (make-initial-dfun gf))))