(qualifiers (subseq qab 0 arglist-pos))
(body (nthcdr (1+ arglist-pos) qab)))
`(push (defmethod ,fun-name ,@qualifiers ,arglist ,@body)
- (generic-function-initial-methods #',fun-name)))))
+ (generic-function-initial-methods (fdefinition ',fun-name))))))
(macrolet ((initarg (key) `(getf initargs ,key)))
(dolist (option options)
(let ((car-option (car option)))
(compile-or-load-defgeneric ',fun-name))
(load-defgeneric ',fun-name ',lambda-list ,@initargs)
,@(mapcar #'expand-method-definition methods)
- #',fun-name))))
+ (fdefinition ',fun-name)))))
(defun compile-or-load-defgeneric (fun-name)
(proclaim-as-fun-name fun-name)
(setq next-method-p-p t)
form)
((eq (car form) 'setq)
+ ;; FIXME: this is possibly a little strong as
+ ;; conditions go. Ideally we would want to detect
+ ;; which, if any, of the method parameters are
+ ;; being set, and communicate that information to
+ ;; e.g. SPLIT-DECLARATIONS. However, the brute
+ ;; force method doesn't really cost much; a little
+ ;; loss of discrimination over IGNORED variables
+ ;; should be all. -- CSR, 2004-07-01
(setq setq-p t)
form)
((and (eq (car form) 'function)
(unless (equal ,pos ,valsym)
(setf ,pos ,valsym)))))
+(defun create-gf-lambda-list (lambda-list)
+ ;;; Create a gf lambda list from a method lambda list
+ (loop for x in lambda-list
+ collect (if (consp x) (list (car x)) x)
+ if (eq x '&key) do (loop-finish)))
+
(defun set-arg-info (gf &key new-method (lambda-list nil lambda-list-p)
argument-precedence-order)
(let* ((arg-info (if (eq *boot-state* 'complete)
(error "The lambda-list ~S is incompatible with ~
existing methods of ~S."
lambda-list gf))))
- (when lambda-list-p
- (esetf (arg-info-lambda-list arg-info) lambda-list))
+ (esetf (arg-info-lambda-list arg-info)
+ (if lambda-list-p
+ lambda-list
+ (create-gf-lambda-list lambda-list)))
(when (or lambda-list-p argument-precedence-order
(null (arg-info-precedence arg-info)))
(esetf (arg-info-precedence arg-info)
(let* ((method (car (last methods)))
(ll (if (consp method)
(early-method-lambda-list method)
- (method-lambda-list method)))
- (k (member '&key ll)))
- (if k
- (ldiff ll (cdr k))
- ll))))
+ (method-lambda-list method))))
+ (create-gf-lambda-list ll))))
(arg-info-lambda-list arg-info))))
(defmacro real-ensure-gf-internal (gf-class all-keys env)