Changeset 13184
- Timestamp:
- 01/25/11 21:56:33 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r12982 r13184 1473 1473 gf-keywords))))))) 1474 1474 1475 (defun check-method-lambda-list ( method-lambda-list gf-lambda-list)1475 (defun check-method-lambda-list (name method-lambda-list gf-lambda-list) 1476 1476 (let* ((gf-restp (not (null (memq '&rest gf-lambda-list)))) 1477 1477 (gf-plist (analyze-lambda-list gf-lambda-list)) … … 1485 1485 (unless (= (length (getf gf-plist :required-args)) 1486 1486 (length (getf method-plist :required-args))) 1487 (error "The method has the wrong number of required arguments for the generic function.")) 1487 (error "The method-lambda-list ~S ~ 1488 has the wrong number of required arguments ~ 1489 for the generic function ~S." method-lambda-list name)) 1488 1490 (unless (= (length (getf gf-plist :optional-args)) 1489 1491 (length (getf method-plist :optional-args))) 1490 (error "The method has the wrong number of optional arguments for the generic function.")) 1492 (error "The method-lambda-list ~S ~ 1493 has the wrong number of optional arguments ~ 1494 for the generic function ~S." method-lambda-list name)) 1491 1495 (unless (eq (or gf-restp gf-keysp) (or method-restp method-keysp)) 1492 (error "The method and the generic function differ in whether they accept &REST or &KEY arguments.")) 1496 (error "The method-lambda-list ~S ~ 1497 and the generic function ~S ~ 1498 differ in whether they accept &REST or &KEY arguments." 1499 method-lambda-list name)) 1493 1500 (when (consp gf-keywords) 1494 1501 (unless (or (and method-restp (not method-keysp)) 1495 1502 method-allow-other-keys-p 1496 1503 (every (lambda (k) (memq k method-keywords)) gf-keywords)) 1497 (error "The method does not accept all of the keyword arguments defined for the generic function."))))) 1504 (error "The method-lambda-list ~S does not accept ~ 1505 all of the keyword arguments defined for the ~ 1506 generic function." method-lambda-list name))))) 1498 1507 1499 1508 (declaim (ftype (function * method) ensure-method)) … … 1502 1511 (gf (find-generic-function name nil))) 1503 1512 (if gf 1504 (check-method-lambda-list method-lambda-list (generic-function-lambda-list gf)) 1513 (check-method-lambda-list name method-lambda-list 1514 (generic-function-lambda-list gf)) 1505 1515 (setf gf (ensure-generic-function name :lambda-list method-lambda-list))) 1506 1516 (let ((method … … 2140 2150 (gf (find-generic-function function-name nil))) 2141 2151 (if gf 2142 (check-method-lambda-list method-lambda-list (generic-function-lambda-list gf)) 2143 (setf gf (ensure-generic-function function-name :lambda-list method-lambda-list))) 2152 (check-method-lambda-list function-name 2153 method-lambda-list 2154 (generic-function-lambda-list gf)) 2155 (setf gf (ensure-generic-function function-name :lambda-list method-lambda-list))) 2144 2156 (let ((method 2145 2157 (make-instance-standard-reader-method gf … … 2960 2972 2961 2973 (defmethod find-method ((generic-function standard-generic-function) 2962 2974 qualifiers specializers &optional (errorp t)) 2963 2975 (%find-method generic-function qualifiers specializers errorp)) 2964 2976 2965 2977 (defgeneric add-method (generic-function method)) 2966 2978 2967 (defmethod add-method ((generic-function standard-generic-function) (method method)) 2979 (defmethod add-method ((generic-function standard-generic-function) 2980 (method method)) 2968 2981 (let ((method-lambda-list (method-lambda-list method)) 2969 2982 (gf-lambda-list (generic-function-lambda-list generic-function))) 2970 (check-method-lambda-list method-lambda-list gf-lambda-list)) 2983 (check-method-lambda-list (%generic-function-name generic-function) 2984 method-lambda-list gf-lambda-list)) 2971 2985 (%add-method generic-function method)) 2972 2986
Note: See TracChangeset
for help on using the changeset viewer.