Hello! I think the problem is in the pcl::standard-method, because if I change the :method-class (when I call defgeneric in the defmethod* macro) to a pcl::standard-method, then it works.
The question now is: why I can't put a subclass of pcl::standard-method (OMMethod in this case) instead the class pcl::standard-method ? Maybe my theory is wrong but I think this shouldn't happend. Gerardo M. Sarria M. PS: I'm using the cmucl version 20030126 for x86 ------------------------------------------------------------------------------ Gerardo Sarria a �crit : > Hello! > > Now, I try to create a macro called defmethod* > The reason is that I want to have more attributes in one method (like name of icon, etc.). > > Then I have this code: > > (defclass OMMethod (pcl::standard-method) > () (:metaclass standard-class)) > > (defvar *function-specs* ()) > (defun function-spec-p (spec) > (or (symbolp spec) > (and (consp spec) > (symbolp (setq spec (car spec))) > (not (eq spec 'lambda)) > (getf *function-specs* spec)))) > > (defun parse-defmethod* (name args) > (unless (function-spec-p name) (error "Illegal arg ~S" name)) > (let* ((theargs args) (body? nil) > qualy lambda-list icon numouts initvals doc menuins body indoc) > (when (or (equal (car theargs) :after) > (equal (car theargs) :before) > (equal (car theargs) :around)) > (setf qualy (pop theargs))) > (setf lambda-list (pop theargs)) > (loop while (and theargs (not body?)) > do > (cond > ((equal (car theargs) :numouts) (pop theargs) (setf numouts (pop theargs))) > ((equal (car theargs) :initvals) (pop theargs) (setf initvals (pop theargs))) > ((equal (car theargs) :indoc) (pop theargs) (setf indoc (pop theargs))) > ((equal (car theargs) :doc) (pop theargs) (setf doc (pop theargs))) > ((equal (car theargs) :icon) (pop theargs) (setf icon (pop theargs))) > ((equal (car theargs) :menuins) (pop theargs) (setf menuins (pop theargs))) > ((stringp (car theargs)) (setf doc (pop theargs))) > (t (setf body theargs) (setf body? t)))) > (unless numouts (setf numouts 1)) > (unless doc (setf doc "no documentation for this function")) > (unless icon (setf icon 150)) ;an icon by default > (values qualy lambda-list numouts initvals icon indoc doc menuins body))) > > (defun first? (thing) (if (listp thing) (first thing) thing)) > (defun get-lambda-var (list) (mapcar #'(lambda (nom) (first? nom)) list)) > > (defmacro defmethod* (name &rest args) > (multiple-value-bind (qualy lambda-list numouts initvals icon indoc doc menuins body) > (parse-defmethod* name args) > (let ((lambda-var (get-lambda-var lambda-list))) > (unless initvals > (setf initvals `',(make-list (length lambda-var) :initial-element nil))) > (unless indoc > (setf indoc `',(make-list (length lambda-var) :initial-element "no documentation"))) > `(progn > (unless (fboundp ',name) > (let* (gen-fun) > (setf gen-fun (defgeneric ,name ,lambda-var > (:documentation ,doc) > (:generic-function-class standard-generic-function) > (:method-class OMMethod))))) > (let ((method (if ,qualy > (defmethod ,name ,qualy ,lambda-list ,.body) > (defmethod ,name ,lambda-list ,.body)))) > method))))) > > but when I call the macro, it stays in an infinite loop until segmentation fault. > For example: > > (defmethod* hello ((self t)) (print "hello!")) > > ; In: DEFMETHOD HELLO NIL > > ; (DEFMETHOD HELLO > ; NIL > ; (#) > ; (PRINT "hello!")) > ; Error: (during macroexpansion) > ; > ; Error in function WALKER::GET-WALKER-TEMPLATE: > ; Can't get template for (SELF T) > ; > Segmentation fault (core dumped) > [EMAIL PROTECTED] Image]$ > > So, I really don't know what happened. > If somebody has any idea, please. > > Gerardo M. Sarria M.
