William Harold Newman <william.newman@...> writes:
> I can't get PROGN method combination to work in PCL with the
> :MOST-SPECIFIC-LAST option. I've never used it before, and I find the
> documentation a little obscure, so I'm not 100% sure it's entirely a
> problem with PCL and not a problem with me doing something weird, so
> I'm posting it here to check instead of just making a BUGS entry
> directly.
[...]
> Incidentally, if it is a bug, I'd be interested to know whether the
> CMU CL does the same thing.
Sorry for responding so late, (extremely busy is my current excuse du
jour), but that's an old bug, which has been fixed by me CMU CL some
time ago, after a user-report on cmucl-help. Below is the
corresponding patch and commit log. I've also included the log and
diff of another fix, which you might want to look into. This fixes
invalid-method-error and method-combination-error, which were causing
invalid "called outside of method-combination" errors. A simple
test-case would be:
(defgeneric zut (x) (:method-combination progn))
(defmethod zut ((x t)) 5)
The second form should signal a proper invalid-method-error, but
signals instead an error claiming that i-m-e was called outside a
method-combination. The appended patch also improves error checking
for standard-method-combination somewhat, so that invalid qualifiers
are detected and reported, instead of making them primary methods.
Regs, Pierre.
revision 1.12
date: 2001/09/23 19:02:12; author: pmai; state: Exp; lines: +5 -3
Fixes a bug in short-method-combination handling reported on
cmucl-help: The optional order argument to method combinations
defined by the short form of define-method-combination was being
quietly ignored, resulting in the default :most-specific-first
behaviour, even if :most-specific-last was specified. This fix makes
it respect the specified order.
----------------------------
revision 1.11
date: 2001/04/25 21:44:51; author: pmai; state: Exp; lines: +24 -1
o Fixed the implementation of INVALID-METHOD-ERROR and METHOD-COMBINATION-ERROR
by fixing bootstrapping problems with the disabled around method of
COMPUTE-EFFECTIVE-METHOD, and reinstating it.
o Added stricter error checking for standard method combination.
----------------------------
First patch:
Index: defcombin.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/pcl/defcombin.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- defcombin.lisp 2001/04/25 21:44:51 1.11
+++ defcombin.lisp 2001/09/23 19:02:12 1.12
@@ -26,7 +26,7 @@
;;;
(ext:file-comment
- "$Header: /home/CVS-cmucl/src/pcl/defcombin.lisp,v 1.11 2001/04/25 21:44:51 pmai Exp $")
+ "$Header: /home/CVS-cmucl/src/pcl/defcombin.lisp,v 1.12 2001/09/23 19:02:12 pmai Exp $")
;;;
(in-package :pcl)
@@ -171,6 +171,7 @@
(let ((type (method-combination-type combin))
(operator (short-combination-operator combin))
(ioa (short-combination-identity-with-one-argument combin))
+ (order (car (method-combination-options combin)))
(around ())
(primary ()))
(dolist (m applicable-methods)
@@ -194,8 +195,9 @@
(push m primary))
(t
(lose m "has an illegal qualifier"))))))
- (setq around (nreverse around)
- primary (nreverse primary))
+ (setq around (nreverse around))
+ (unless (eq order :most-specific-last)
+ (setq primary (nreverse primary)))
(let ((main-method
(if (and (null (cdr primary))
(not (null ioa)))
Second Patch:
Index: combin.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/pcl/combin.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- combin.lisp 1999/05/30 23:13:54 1.9
+++ combin.lisp 2001/04/25 21:44:51 1.10
@@ -26,7 +26,7 @@
;;;
(ext:file-comment
- "$Header: /home/CVS-cmucl/src/pcl/combin.lisp,v 1.9 1999/05/30 23:13:54 pw Exp $")
+ "$Header: /home/CVS-cmucl/src/pcl/combin.lisp,v 1.10 2001/04/25 21:44:51 pmai Exp $")
;;;
(in-package :pcl)
@@ -311,38 +311,56 @@
(primary ())
(after ())
(around ()))
- (dolist (m applicable-methods)
- (let ((qualifiers (if (listp m)
- (early-method-qualifiers m)
- (method-qualifiers m))))
- (cond ((member ':before qualifiers) (push m before))
- ((member ':after qualifiers) (push m after))
- ((member ':around qualifiers) (push m around))
- (t
- (push m primary)))))
+ (flet ((lose (method why)
+ (invalid-method-error
+ method
+ "The method ~S ~A.~%~
+ Standard method combination requires all methods to have one~%~
+ of the single qualifiers :AROUND, :BEFORE and :AFTER or to~%~
+ have no qualifier at all."
+ method why)))
+ (dolist (m applicable-methods)
+ (let ((qualifiers (if (listp m)
+ (early-method-qualifiers m)
+ (method-qualifiers m))))
+ (cond
+ ((null qualifiers) (push m primary))
+ ((cdr qualifiers)
+ (lose m "has more than one qualifier"))
+ ((eq (car qualifiers) :around)
+ (push m around))
+ ((eq (car qualifiers) :before)
+ (push m before))
+ ((eq (car qualifiers) :after)
+ (push m after))
+ (t
+ (lose m "has an illegal qualifier"))))))
(setq before (reverse before)
after (reverse after)
primary (reverse primary)
around (reverse around))
(cond ((null primary)
- `(error "No primary method for the generic function ~S." ',generic-function))
+ `(error "No primary method for the generic function ~S."
+ ',generic-function))
((and (null before) (null after) (null around))
;;
- ;; By returning a single call-method `form' here we enable an important
- ;; implementation-specific optimization.
+ ;; By returning a single call-method `form' here we enable an
+ ;; important implementation-specific optimization.
;;
`(call-method ,(first primary) ,(rest primary)))
(t
(let ((main-effective-method
(if (or before after)
`(multiple-value-prog1
- (progn ,(make-call-methods before)
- (call-method ,(first primary) ,(rest primary)))
+ (progn
+ ,(make-call-methods before)
+ (call-method ,(first primary) ,(rest primary)))
,(make-call-methods (reverse after)))
`(call-method ,(first primary) ,(rest primary)))))
(if around
`(call-method ,(first around)
- (,@(rest around) (make-method ,main-effective-method)))
+ (,@(rest around)
+ (make-method ,main-effective-method)))
main-effective-method))))))
;;;
@@ -378,6 +396,8 @@
DEFINE-METHOD-COMBINATION or a method on the generic~%~
function COMPUTE-EFFECTIVE-METHOD).")))
+;This definition appears in defcombin.lisp.
+;
;(defmethod compute-effective-method :around ;issue with magic
; ((generic-function generic-function) ;generic functions
; (method-combination method-combination)
Index: defcombin.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/pcl/defcombin.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- defcombin.lisp 1999/05/30 23:13:55 1.10
+++ defcombin.lisp 2001/04/25 21:44:51 1.11
@@ -26,7 +26,7 @@
;;;
(ext:file-comment
- "$Header: /home/CVS-cmucl/src/pcl/defcombin.lisp,v 1.10 1999/05/30 23:13:55 pw Exp $")
+ "$Header: /home/CVS-cmucl/src/pcl/defcombin.lisp,v 1.11 2001/04/25 21:44:51 pmai Exp $")
;;;
(in-package :pcl)
@@ -41,6 +41,29 @@
(listp (caddr form)))
(expand-long-defcombin form)
(expand-short-defcombin form)))
+
+
+;;;
+;;; Implementation of INVALID-METHOD-ERROR and METHOD-COMBINATION-ERROR
+;;;
+;;; See combin.lisp for rest of the implementation. This method is
+;;; defined here because compute-effective-method is still a function
+;;; in combin.lisp.
+;;;
+(defmethod compute-effective-method :around
+ ((generic-function generic-function)
+ (method-combination method-combination)
+ applicable-methods)
+ (declare (ignore applicable-methods))
+ (flet ((real-invalid-method-error (method format-string &rest args)
+ (declare (ignore method))
+ (apply #'error format-string args))
+ (real-method-combination-error (format-string &rest args)
+ (apply #'error format-string args)))
+ (let ((*invalid-method-error* #'real-invalid-method-error)
+ (*method-combination-error* #'real-method-combination-error))
+ (call-next-method))))
+
;;;
--
Pierre R. Mai <pmai@...> http://www.pmsf.de/pmai/
The most likely way for the world to be destroyed, most experts agree,
is by accident. That's where we come in; we're computer professionals.
We cause accidents. -- Nathaniel Borenstein
|