implementing defmethod using the mop ===> pcl problem

Hi!

Based on the information on method initialization in the MOP
documentation, I wrote a simple implementation of defmethod using
#'make-method-lambda, #'add-method etc.:

(defun normalized-argument (specialized-argument)
(if (atom specialized-argument) (list specialized-argument t)
specialized-argument))

(defun split-special-arguments (args)
(when args
(if (member (car args) '(&rest &key &optional)) (values nil args)
(multiple-value-bind
(basic special)
(split-special-arguments (cdr args))
(values (cons (car args) basic) special)))))

(defun specializers (args)
(mapcar
#'(lambda (specializer)
(if (atom specializer) (find-class specializer)
(intern-eql-specializer (cadr specializer))))
(mapcar #'cadr
(mapcar #'normalized-argument
(split-special-arguments args)))))

(defun unspecialized (args)
(multiple-value-bind
(basic special)
(split-special-arguments args)
(concatenate 'list
(mapcar #'car (mapcar #'normalized-argument basic))
special)))

(defmacro defmethod
(name &rest definition &environment context)
(let* ((qualifiers
(when (atom (car definition)) (list (car definition))))
(at-args (if qualifiers (cdr definition) definition))
(args (car at-args))
(body (cdr at-args))
(generic (ensure-generic-function name))
(method (gensym)))
(multiple-value-bind
(method-lambda initializers)
(make-method-lambda generic
(class-prototype
(generic-function-method-class generic))
`(lambda ,args ,@body) context)
`(let ((,method
(apply #'make-instance
(generic-function-method-class ,generic)
:qualifiers ',qualifiers :specializers
(specializers ',args) :lambda-list
(unspecialized ',args) :function
#',method-lambda ',initializers)))
(add-method ,generic ,method)
,method))))

For sure, it does not handle all the possible defmethod
invocations. But it already handles many basic cases. However,
dispatching multi-methods notably fails on the implementations I could
test it on (sbcl and gcl compiled in ANSI mode). This can be verified
using the following test code:

(defclass foo nil ((foo :initarg foo)))

(defclass bar nil ((bar :initarg bar)))

(defgeneric baz (x y))

(defmethod baz ((x foo) (y bar))
(list (slot-value x 'foo) (slot-value y 'bar)))

(baz (make-instance 'foo 'foo 1) (make-instance 'bar 'bar 2))

The last form should evaluate to (1 2), but both implementations error
out somewhere inside pcl::pv-table-lookup-pv-args. Is there something
wrong in my defmethod implementation regarding this? Is there a free
CLOS implementation with MOP out there that is not based on PCL, so I
can test the code on it?

Thanks in advance

Isidor Zeuner
.