(multiple-value-bind (walked-lambda-body
walked-declarations
walked-documentation)
(parse-body (cddr walked-lambda))
(declare (ignore walked-documentation))
(when (some #'cdr slots)
(multiple-value-bind (walked-lambda-body
walked-declarations
walked-documentation)
(parse-body (cddr walked-lambda))
(declare (ignore walked-documentation))
(when (some #'cdr slots)
(setq plist
`(,@(when slot-name-lists
`(:slot-name-lists ,slot-name-lists))
(setq plist
`(,@(when slot-name-lists
`(:slot-name-lists ,slot-name-lists))
- :slot-name-lists ',slot-name-lists
- :call-list ',call-list)))
+ :slot-name-lists ',slot-name-lists)))
,@walked-lambda-body)))))
(when (and (memq '&key lambda-list)
(not (memq '&allow-other-keys lambda-list)))
,@walked-lambda-body)))))
(when (and (memq '&key lambda-list)
(not (memq '&allow-other-keys lambda-list)))
(defmacro invoke-fast-method-call (method-call restp &rest required-args+rest-arg)
`(,(if restp 'apply 'funcall) (fast-method-call-function ,method-call)
(defmacro invoke-fast-method-call (method-call restp &rest required-args+rest-arg)
`(,(if restp 'apply 'funcall) (fast-method-call-function ,method-call)
(fast-method-call-next-method-call ,method-call)
,@required-args+rest-arg))
(fast-method-call-next-method-call ,method-call)
,@required-args+rest-arg))
&rest required-args)
(macrolet ((generate-call (n)
``(funcall (fast-method-call-function ,method-call)
&rest required-args)
(macrolet ((generate-call (n)
``(funcall (fast-method-call-function ,method-call)
(values (fast-method-call-next-method-call ,method-call))
,@required-args
(sb-c::%more-arg-values ,more-context 0 ,more-count))))))
(values (fast-method-call-next-method-call ,method-call))
,@required-args
(sb-c::%more-arg-values ,more-context 0 ,more-count))))))
\f
(defun analyze-lambda-list (lambda-list)
(flet (;; FIXME: Is this redundant with SB-C::MAKE-KEYWORD-FOR-ARG?
\f
(defun analyze-lambda-list (lambda-list)
(flet (;; FIXME: Is this redundant with SB-C::MAKE-KEYWORD-FOR-ARG?
(initialize-method-function initargs result)
result)))
(defun real-make-a-method
(class qualifiers lambda-list specializers initargs doc
(initialize-method-function initargs result)
result)))
(defun real-make-a-method
(class qualifiers lambda-list specializers initargs doc
(if method-class-function
(let* ((object-class (if (classp object-class) object-class
(find-class object-class)))
(if method-class-function
(let* ((object-class (if (classp object-class) object-class
(find-class object-class)))
initargs)))
(apply #'make-instance class :qualifiers qualifiers
:lambda-list lambda-list :specializers specializers
initargs)))
(apply #'make-instance class :qualifiers qualifiers
:lambda-list lambda-list :specializers specializers
(setf (fifth (fifth early-method)) new-value))
(defun early-add-named-method (generic-function-name qualifiers
(setf (fifth (fifth early-method)) new-value))
(defun early-add-named-method (generic-function-name qualifiers
(let* (;; we don't need to deal with the :generic-function-class
;; argument here because the default,
;; STANDARD-GENERIC-FUNCTION, is right for all early generic
(let* (;; we don't need to deal with the :generic-function-class
;; argument here because the default,
;; STANDARD-GENERIC-FUNCTION, is right for all early generic
(setf (getf (getf initargs 'plist) :name)
(make-method-spec gf qualifiers specializers))
(let ((new (make-a-method 'standard-method qualifiers arglist
(setf (getf (getf initargs 'plist) :name)
(make-method-spec gf qualifiers specializers))
(let ((new (make-a-method 'standard-method qualifiers arglist