[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
CPL and method-update bug (& fix?)
- To: commonloops.pa@Xerox.COM
- Subject: CPL and method-update bug (& fix?)
- From: Mike Thome <mthome@BBN.COM>
- Date: Wed, 17 May 89 12:14:24 -0400
- Redistributed: commonloops.pa
- Reply-to: <Owners-commonloops.pa@Xerox.COM>
We've noticed the following bug in Cinco-de-Mayo PCL:
(defclass class-a () ())
(defmethod meth-1 ((x class-a)) (print 'class-a))
;; ^- recomputes combination points
(defclass b-mixin () ())
(defmethod meth-1 :after ((x b-mixin)) (print 'b-mixin))
(meth-1 (make-instance 'class-a)) ;compute-c-p
;; ^- recomputes combination points
(defclass a-and-b (b-mixin class-a) ())
;; ^- doesn't recompute combination points
(meth-1 (make-instance 'a-and-b))
;; ^- doesn't recompute combination points, and blows up with
;; "no applicable primary method" error.
Below is a fix for the problem - probably not the *right* one, but it
does seem to make things work:
(defmethod update-method-inheritance ((class standard-class) old-cpl new-cpl)
(unless (or ;(null old-cpl) ; mthome@bbn - for new ones, too
(equal old-cpl new-cpl))
(let* ((shared-tail (shared-tail old-cpl new-cpl))
(old (butlast old-cpl (length shared-tail)))
(new (butlast new-cpl (length shared-tail)))
(seen-gfs ()))
(labels ((consider-gf (gf)
(unless (memq gf seen-gfs)
(push gf seen-gfs)
(when (check-method-precedences gf)
(update gf))))
(check-method-precedences (gf)
(block check-method-precedences
(let* ((specializers
(delete-duplicates
(apply #'append
(mapcar #'method-type-specifiers
(generic-function-methods gf)))))
(old-precedence
(gathering1 (collecting)
(dolist (o old)
(when (memq o specializers) (gather1 o))))))
(dolist (n new)
(when (memq n specializers)
(unless (eq n (pop old-precedence))
(return-from check-method-precedences t)))))))
(update (gf)
(invalidate-generic-function gf)))
(dolist (o old)
(dolist (dm (class-direct-methods o))
(consider-gf (method-generic-function dm))))
(dolist (n new)
(unless (memq n old)
(dolist (dm (class-direct-methods n))
(consider-gf (method-generic-function dm)))))))))