- (make-method-call :function mf
- ;; FIXME: this is wrong. Very wrong.
- ;; It assumes that the only place that
- ;; can have make-method calls is in
- ;; the list structure of the second
- ;; argument to CALL-METHOD, but AMOP
- ;; says that CALL-METHOD can be more
- ;; complicated if
- ;; COMPUTE-EFFECTIVE-METHOD (and
- ;; presumably MAKE-METHOD-LAMBDA) is
- ;; adjusted to match.
- ;;
- ;; On the other hand, it's a start,
- ;; because without this calls to
- ;; MAKE-METHOD in method combination
- ;; where one of the methods is of a
- ;; user-defined class don't work at
- ;; all. -- CSR, 2006-08-05
- :call-method-args (cons (mapcar #'frob-cm-arg (car cm-args))
- (cdr cm-args))))
+ (let* ((default (cons nil nil))
+ (value
+ (method-plist-value method :constant-value default))
+ ;; FIXME: this is wrong. Very wrong. It assumes
+ ;; that the only place that can have make-method
+ ;; calls is in the list structure of the second
+ ;; argument to CALL-METHOD, but AMOP says that
+ ;; CALL-METHOD can be more complicated if
+ ;; COMPUTE-EFFECTIVE-METHOD (and presumably
+ ;; MAKE-METHOD-LAMBDA) is adjusted to match.
+ ;;
+ ;; On the other hand, it's a start, because
+ ;; without this calls to MAKE-METHOD in method
+ ;; combination where one of the methods is of a
+ ;; user-defined class don't work at all. -- CSR,
+ ;; 2006-08-05
+ (args (cons (mapcar #'frob-cm-arg (car cm-args))
+ (cdr cm-args))))
+ (if (eq value default)
+ (make-method-call :function mf :call-method-args args)
+ (make-constant-method-call :function mf :value value
+ :call-method-args args))))