/[cmucl]/src/pcl/combin.lisp
ViewVC logotype

Diff of /src/pcl/combin.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6.2.2 by pw, Tue May 23 16:38:43 2000 UTC revision 1.6.2.3 by pw, Sat Mar 23 18:51:15 2002 UTC
# Line 311  Line 311 
311          (primary ())          (primary ())
312          (after ())          (after ())
313          (around ()))          (around ()))
314      (dolist (m applicable-methods)      (flet ((lose (method why)
315        (let ((qualifiers (if (listp m)               (invalid-method-error
316                              (early-method-qualifiers m)                method
317                              (method-qualifiers m))))                "The method ~S ~A.~%~
318          (cond ((member ':before qualifiers)  (push m before))                 Standard method combination requires all methods to have one~%~
319                ((member ':after  qualifiers)  (push m after))                 of the single qualifiers :AROUND, :BEFORE and :AFTER or to~%~
320                ((member ':around  qualifiers) (push m around))                 have no qualifier at all."
321                (t                method why)))
322                 (push m primary)))))        (dolist (m applicable-methods)
323            (let ((qualifiers (if (listp m)
324                                  (early-method-qualifiers m)
325                                  (method-qualifiers m))))
326              (cond
327                ((null qualifiers) (push m primary))
328                ((cdr qualifiers)
329                 (lose m "has more than one qualifier"))
330                ((eq (car qualifiers) :around)
331                 (push m around))
332                ((eq (car qualifiers) :before)
333                 (push m before))
334                ((eq (car qualifiers) :after)
335                 (push m after))
336                (t
337                 (lose m "has an illegal qualifier"))))))
338      (setq before  (reverse before)      (setq before  (reverse before)
339            after   (reverse after)            after   (reverse after)
340            primary (reverse primary)            primary (reverse primary)
341            around  (reverse around))            around  (reverse around))
342      (cond ((null primary)      (cond ((null primary)
343             `(error "No primary method for the generic function ~S." ',generic-function))             `(error "No primary method for the generic function ~S."
344                 ',generic-function))
345            ((and (null before) (null after) (null around))            ((and (null before) (null after) (null around))
346             ;;             ;;
347             ;; By returning a single call-method `form' here we enable an important             ;; By returning a single call-method `form' here we enable an
348             ;; implementation-specific optimization.             ;; important implementation-specific optimization.
349             ;;             ;;
350             `(call-method ,(first primary) ,(rest primary)))             `(call-method ,(first primary) ,(rest primary)))
351            (t            (t
352             (let ((main-effective-method             (let ((main-effective-method
353                     (if (or before after)                     (if (or before after)
354                         `(multiple-value-prog1                         `(multiple-value-prog1
355                            (progn ,(make-call-methods before)                            (progn
356                                   (call-method ,(first primary) ,(rest primary)))                              ,(make-call-methods before)
357                                (call-method ,(first primary) ,(rest primary)))
358                            ,(make-call-methods (reverse after)))                            ,(make-call-methods (reverse after)))
359                         `(call-method ,(first primary) ,(rest primary)))))                         `(call-method ,(first primary) ,(rest primary)))))
360               (if around               (if around
361                   `(call-method ,(first around)                   `(call-method ,(first around)
362                                 (,@(rest around) (make-method ,main-effective-method)))                                 (,@(rest around)
363                                    (make-method ,main-effective-method)))
364                   main-effective-method))))))                   main-effective-method))))))
365    
366  ;;;  ;;;
# Line 378  Line 396 
396                 DEFINE-METHOD-COMBINATION or a method on the generic~%~                 DEFINE-METHOD-COMBINATION or a method on the generic~%~
397                 function COMPUTE-EFFECTIVE-METHOD).")))                 function COMPUTE-EFFECTIVE-METHOD).")))
398    
399    ;This definition appears in defcombin.lisp.
400    ;
401  ;(defmethod compute-effective-method :around        ;issue with magic  ;(defmethod compute-effective-method :around        ;issue with magic
402  ;          ((generic-function generic-function)     ;generic functions  ;          ((generic-function generic-function)     ;generic functions
403  ;           (method-combination method-combination)  ;           (method-combination method-combination)

Legend:
Removed from v.1.6.2.2  
changed lines
  Added in v.1.6.2.3

  ViewVC Help
Powered by ViewVC 1.1.5