classmethod on clos

gistfile1.cl

(defun extract-argument-symbols (args)
  (mapcar #'(lambda (x) (if (listp x) (car x) x)) args))

(defconstant +built-in-class-instances-table+
   `((arithmetic-error . ,(make-condition 'arithmetic-error))
      ...))

(defun lookup-built-in-class-object (class)
  (cdr (assoc class +built-in-class-instances-table+)))

(defmacro define-class-method-wrapper (name args &optional (documentation nil))
  ;; args => ((class class-name) arg2 arg3 ...)
  (let ((class-obj (gensym)))
    `(defmethod ,name ((,(car (car args)) symbol) ,@(cdr args))
       "this method was automatically generated by
DEFINE-CLASS-METHOD-WRAPPER."
       (let ((,class-obj (find-class ',(cadr (car args)))))
         (if (typep ,class-obj 'closer-mop:built-in-class)
             (,name (lookup-built-in-class-object ',(cadr (car args)))
                    ,(extract-argument-symbols (cdr args)))
             (,name (allocate-instance ,class-obj)
                    ,(extract-argument-symbols (cdr args)))))))))