Isolate a Method in a Combined Method

isolate-method.lisp

(defmacro methodcall ((name &rest qualifiers-and-args) (&rest arg-values) &body next-function-body)
  (let* ((qualifiers (butlast qualifiers-and-args))
	 (specialized-args (mapcar (lambda (arg) (typecase arg (list arg) (t (list arg t))))
			     (car (last qualifiers-and-args))))
	 (args (mapcar #'car specialized-args))
	 (specializers (mapcar #'cadr specialized-args)))
    (alexandria:with-gensyms (method-obj method-fun next-args next-funs)
      `(let* ((,method-obj (find-method #',name ',qualifiers ',specializers))
	      (,method-fun (closer-mop:method-function ,method-obj)))
	 (funcall ,method-fun (list ,@arg-values)
		  (list (lambda (,next-args ,next-funs)
			  (declare (ignore ,next-funs))
			  (destructuring-bind (,@args) ,next-args
			    ,@next-function-body))))))))

(defgeneric foo (a b stream))

(defmethod foo :before ((a integer) (b string) (stream stream))
  (format stream "~&~d ~a~%" a b))

(defmethod foo :after ((a integer) (b string) (stream stream))
  (format stream "~&~d ~a~%" (1+ a) b))

(defmethod foo :around ((a integer) (b string) (stream stream))
  (format stream "~&~d ~a~%" (+ 2 a) (concatenate 'string "b: " b))
  (call-next-method)
  (format stream "~&~d ~a~%" (+ 3 a) (concatenate 'string b " :b")))

(defmethod foo ((a integer) (b string) (stream stream))
  (format stream "~&The primary method: ~s ~s~%" a b))

#|
CL-TESTING> (methodcall (foo ((a integer) (b string) (c stream))) (2 "foo" *standard-output*)
              (format c "~&a : ~a  b : ~a<<<<~%" a b))

The primary method: 2 "foo"
NIL
CL-TESTING> (methodcall (foo :around ((a integer) (b string) (c stream))) (2 "foo" *standard-output*)
              (format c "~&a : ~a  b : ~a<<<<~%" a b))

4 b: foo
a : 2  b : foo<<<<
5 foo :b
NIL
CL-TESTING> (methodcall (foo :before ((a integer) (b string) (c stream))) (2 "foo" *standard-output*)
              (format c "~&a : ~a  b : ~a<<<<~%" a b))
2 foo
NIL
CL-TESTING> (methodcall (foo :after ((a integer) (b string) (c stream))) (2 "foo" *standard-output*)
              (format c "~&a : ~a  b : ~a<<<<~%" a b))
3 foo
NIL
|#