38 |
(expand-long-defcombin form) |
(expand-long-defcombin form) |
39 |
(expand-short-defcombin form))) |
(expand-short-defcombin form))) |
40 |
|
|
41 |
|
;;; |
42 |
|
;;; Implementation of INVALID-METHOD-ERROR and METHOD-COMBINATION-ERROR |
43 |
|
;;; |
44 |
|
;;; See combin.lisp for rest of the implementation. This method is |
45 |
|
;;; defined here because compute-effective-method is still a function |
46 |
|
;;; in combin.lisp. |
47 |
|
;;; |
48 |
|
(defmethod compute-effective-method :around |
49 |
|
((generic-function generic-function) |
50 |
|
(method-combination method-combination) |
51 |
|
applicable-methods) |
52 |
|
(declare (ignore applicable-methods)) |
53 |
|
(flet ((real-invalid-method-error (method format-string &rest args) |
54 |
|
(declare (ignore method)) |
55 |
|
(apply #'error format-string args)) |
56 |
|
(real-method-combination-error (format-string &rest args) |
57 |
|
(apply #'error format-string args))) |
58 |
|
(let ((*invalid-method-error* #'real-invalid-method-error) |
59 |
|
(*method-combination-error* #'real-method-combination-error)) |
60 |
|
(call-next-method)))) |
61 |
|
|
62 |
|
|
63 |
;;; |
;;; |
64 |
;;; STANDARD method combination |
;;; STANDARD method combination |
128 |
:qualifiers () |
:qualifiers () |
129 |
:specializers specializers |
:specializers specializers |
130 |
:lambda-list '(generic-function type options) |
:lambda-list '(generic-function type options) |
131 |
:function #'(lambda (gf type options) |
:function #'(lambda (args nms &rest cm-args) |
132 |
(declare (ignore gf)) |
(declare (ignore nms cm-args)) |
133 |
(do-short-method-combination |
(apply |
134 |
type options operator ioa new-method doc)) |
(lambda (gf type options) |
135 |
|
(declare (ignore gf)) |
136 |
|
(do-short-method-combination |
137 |
|
type options operator ioa new-method doc)) |
138 |
|
args)) |
139 |
:definition-source `((define-method-combination ,type) ,truename))) |
:definition-source `((define-method-combination ,type) ,truename))) |
140 |
(when old-method |
(when old-method |
141 |
(remove-method #'find-method-combination old-method)) |
(remove-method #'find-method-combination old-method)) |
165 |
(let ((type (method-combination-type combin)) |
(let ((type (method-combination-type combin)) |
166 |
(operator (short-combination-operator combin)) |
(operator (short-combination-operator combin)) |
167 |
(ioa (short-combination-identity-with-one-argument combin)) |
(ioa (short-combination-identity-with-one-argument combin)) |
168 |
|
(order (car (method-combination-options combin))) |
169 |
(around ()) |
(around ()) |
170 |
(primary ())) |
(primary ())) |
171 |
(dolist (m applicable-methods) |
(dolist (m applicable-methods) |
189 |
(push m primary)) |
(push m primary)) |
190 |
(t |
(t |
191 |
(lose m "has an illegal qualifier")))))) |
(lose m "has an illegal qualifier")))))) |
192 |
(setq around (nreverse around) |
(setq around (nreverse around)) |
193 |
primary (nreverse primary)) |
(unless (eq order :most-specific-last) |
194 |
|
(setq primary (nreverse primary))) |
195 |
(let ((main-method |
(let ((main-method |
196 |
(if (and (null (cdr primary)) |
(if (and (null (cdr primary)) |
197 |
(not (null ioa))) |
(not (null ioa))) |