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.
