;;;--------------------------------------------------------------------------
;;; Effective method classes.
+(defmethod method-keyword-argument-lists
+ ((method effective-method) direct-methods)
+ (with-slots (message) method
+ (and (keyword-message-p message)
+ (mapcar (lambda (m)
+ (let ((type (sod-method-type m)))
+ (cons (c-function-keywords type)
+ (format nil "method for ~A on ~A (at ~A)"
+ message
+ (sod-method-class m)
+ (file-location m)))))
+ direct-methods))))
+
(defmethod shared-initialize :after
((method effective-method) slot-names &key direct-methods)
(declare (ignore slot-names))
;; Set the keyword argument list.
(with-slots (message keywords) method
- (setf keywords (and (keyword-message-p message)
- (merge-keyword-lists
- (mapcar (lambda (m)
- (let ((type (sod-method-type m)))
- (cons (c-function-keywords type)
- (format nil "method for ~A on ~A"
- message
- (sod-method-class m)))))
- direct-methods))))))
+ (setf keywords
+ (merge-keyword-lists (method-keyword-argument-lists
+ method direct-methods)))))
(export '(basic-effective-method
effective-method-around-methods effective-method-before-methods
*null-pointer* 0)))
(call-next-method)))))))
-(defmethod compute-method-entry-functions
- ((method simple-effective-method))
- (if (effective-method-primary-methods method)
+(defmethod effective-method-live-p ((method simple-effective-method))
+ (effective-method-primary-methods method))
+
+(defmethod compute-method-entry-functions :around ((method effective-method))
+ (if (effective-method-live-p method)
(call-next-method)
nil))