+ (flet ((frob-cm-arg (arg)
+ (if (if (listp arg)
+ (eq (car arg) :early-method)
+ (method-p arg))
+ arg
+ (if (and (consp arg) (eq (car arg) 'make-method))
+ (let ((emf (make-effective-method-function
+ gf (cadr arg) method-alist wrappers)))
+ (etypecase emf
+ (method-call
+ (make-instance 'standard-method
+ :specializers nil ; XXX
+ :qualifiers nil ; XXX
+ :function (method-call-function emf)))
+ (fast-method-call
+ (let* ((fmf (fast-method-call-function emf))
+ (fun (method-function-from-fast-method-call emf))
+ (mf (%make-method-function fmf nil)))
+ (set-funcallable-instance-function mf fun)
+ (make-instance 'standard-method
+ :specializers nil ; XXX
+ :qualifiers nil
+ :function mf)))))
+ arg))))
+ (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))))