Changeset 14060
- Timestamp:
- 08/06/12 05:41:30 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r14059 r14060 1724 1724 &rest all-keys 1725 1725 &key 1726 lambda-list1726 (lambda-list nil lambda-list-supplied-p) 1727 1727 (generic-function-class +the-standard-generic-function-class+) 1728 1728 (method-class +the-standard-method-class+) 1729 1729 (method-combination +the-standard-method-combination+ mc-p) 1730 1730 argument-precedence-order 1731 documentation1731 (documentation nil documentation-supplied-p) 1732 1732 &allow-other-keys) 1733 1733 (setf all-keys (copy-list all-keys)) ; since we modify it … … 1736 1736 (if gf 1737 1737 (progn 1738 (unless (or (null (generic-function-methods gf)) 1739 (lambda-lists-congruent-p lambda-list (generic-function-lambda-list gf))) 1740 (error 'simple-error 1741 :format-control "The lambda list ~S is incompatible with the existing methods of ~S." 1742 :format-arguments (list lambda-list gf))) 1743 (setf (generic-function-lambda-list gf) lambda-list) 1744 (setf (generic-function-documentation gf) documentation) 1745 (let* ((plist (analyze-lambda-list lambda-list)) 1746 (required-args (getf plist ':required-args))) 1747 (%set-gf-required-args gf required-args) 1748 (%set-gf-optional-args gf (getf plist :optional-args)) 1749 (setf (generic-function-argument-precedence-order gf) 1750 (or argument-precedence-order required-args)) 1751 (finalize-standard-generic-function gf)) 1738 (when lambda-list-supplied-p 1739 (unless (or (null (generic-function-methods gf)) 1740 (lambda-lists-congruent-p lambda-list 1741 (generic-function-lambda-list gf))) 1742 (error 'simple-error 1743 :format-control "The lambda list ~S is incompatible with the existing methods of ~S." 1744 :format-arguments (list lambda-list gf))) 1745 (setf (generic-function-lambda-list gf) lambda-list) 1746 (let* ((plist (analyze-lambda-list lambda-list)) 1747 (required-args (getf plist ':required-args))) 1748 (%set-gf-required-args gf required-args) 1749 (%set-gf-optional-args gf (getf plist :optional-args)))) 1750 (setf (generic-function-argument-precedence-order gf) 1751 (or argument-precedence-order (gf-required-args gf))) 1752 (when documentation-supplied-p 1753 (setf (generic-function-documentation gf) documentation)) 1754 (finalize-standard-generic-function gf) 1752 1755 gf) 1753 1756 (progn … … 4487 4490 &allow-other-keys)) 4488 4491 4489 (defmethod ensure-generic-function-using-class ((generic-function generic-function) 4490 function-name 4491 &rest all-keys 4492 &key (generic-function-class +the-standard-generic-function-class+) 4493 lambda-list 4494 (method-class +the-standard-method-class+) 4495 (method-combination +the-standard-method-combination+) 4496 &allow-other-keys) 4492 (defmethod ensure-generic-function-using-class 4493 ((generic-function generic-function) 4494 function-name 4495 &rest all-keys 4496 &key (generic-function-class +the-standard-generic-function-class+) 4497 (lambda-list nil lambda-list-supplied-p) 4498 (method-class +the-standard-method-class+) 4499 (method-combination +the-standard-method-combination+) 4500 &allow-other-keys) 4497 4501 (setf all-keys (copy-list all-keys)) ; since we modify it 4498 4502 (remf all-keys :generic-function-class) … … 4503 4507 (error "The class ~S is incompatible with the existing class (~S) of ~S." 4504 4508 generic-function-class (class-of generic-function) generic-function)) 4505 (unless (or (null (generic-function-methods generic-function)) 4506 (lambda-lists-congruent-p lambda-list (generic-function-lambda-list generic-function))) 4507 (error "The lambda list ~S is incompatible with the existing methods of ~S." 4508 lambda-list generic-function)) 4509 (when lambda-list-supplied-p 4510 (unless (or (null (generic-function-methods generic-function)) 4511 (lambda-lists-congruent-p lambda-list 4512 (generic-function-lambda-list generic-function))) 4513 (error "The lambda list ~S is incompatible with the existing methods of ~S." 4514 lambda-list generic-function))) 4509 4515 (unless (or (null (generic-function-methods generic-function)) 4510 4516 (eq method-class (generic-function-method-class generic-function)))
Note: See TracChangeset
for help on using the changeset viewer.