From: Isidor Zeuner
Subject: implementing defmethod using the mop ===> pcl problem
Date: 
Message-ID: <slrng1dt1j.7e7.zeuner@galatea.chaosweb.free>
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