Changeset 13959


Ignore:
Timestamp:
06/11/12 12:26:37 (9 years ago)
Author:
rschlatte
Message:

Implement compute-effective-method

  • possibly not quite compliant: we return only one value instead of the specified two.
Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13958 r13959  
    11311131                     ;; by not generating an emf when there are no next methods,
    11321132                     ;; we ensure next-method-p returns NIL
    1133                      (compute-effective-method-function
    1134                         ,gf (process-next-method-list next-method-list))))))
     1133                     (compute-effective-method
     1134                      ,gf (generic-function-method-combination ,gf)
     1135                      (process-next-method-list next-method-list))))))
    11351136     ,@forms))
    11361137
     
    22082209    (if applicable-methods
    22092210        (let* ((emfun (funcall (if (eq (class-of gf) +the-standard-generic-function-class+)
    2210                                    #'std-compute-effective-method-function
    2211                                    #'compute-effective-method-function)
    2212                                gf applicable-methods))
     2211                                   #'std-compute-effective-method
     2212                                   #'compute-effective-method)
     2213                               gf (generic-function-method-combination gf)
     2214                               applicable-methods))
    22132215               (non-keyword-args
    22142216                (+ (length (gf-required-args gf))
     
    22382240    (if applicable-methods
    22392241        (let ((emfun (funcall (if (eq (class-of gf) +the-standard-generic-function-class+)
    2240                                   #'std-compute-effective-method-function
    2241                                   #'compute-effective-method-function)
    2242                               gf applicable-methods)))
     2242                                  #'std-compute-effective-method
     2243                                  #'compute-effective-method)
     2244                              gf (generic-function-method-combination gf)
     2245                              applicable-methods)))
    22432246          (when emfun
    22442247            (setf (gethash arg-specialization (classes-to-emf-table gf)) emfun))
     
    23052308          next-method-list))
    23062309
    2307 (defun std-compute-effective-method-function (gf methods)
    2308   (let* ((mc (generic-function-method-combination gf))
    2309          (mc-name (if (atom mc) mc (%car mc)))
     2310(defun std-compute-effective-method (gf mc methods)
     2311  (let* ((mc-name (if (atom mc) mc (%car mc)))
    23102312         (options (if (atom mc) '() (%cdr mc)))
    23112313         (order (car options))
     
    23432345              (funcall
    23442346               (if (eq (class-of gf) +the-standard-generic-function-class+)
    2345                    #'std-compute-effective-method-function
    2346                    #'compute-effective-method-function)
    2347                gf (remove around methods))))
     2347                   #'std-compute-effective-method
     2348                   #'compute-effective-method)
     2349               gf (generic-function-method-combination gf)
     2350               (remove around methods))))
    23482351         (setf emf-form
    23492352               (generate-emf-lambda (std-method-function around) next-emfun))))
     
    36883691    (std-method-more-specific-p method1 method2 required-classes method-indices)))
    36893692
    3690 ;;; XXX AMOP has COMPUTE-EFFECTIVE-METHOD
    3691 (defgeneric compute-effective-method-function (gf methods))
    3692 (defmethod compute-effective-method-function ((gf standard-generic-function) methods)
    3693   (std-compute-effective-method-function gf methods))
     3693;;; AMOP pg. 176
     3694(defgeneric compute-effective-method (gf method-combination methods))
     3695(defmethod compute-effective-method ((gf standard-generic-function) method-combination methods)
     3696  (std-compute-effective-method gf method-combination methods))
    36943697
    36953698(defgeneric compute-applicable-methods (gf args))
  • trunk/abcl/src/org/armedbear/lisp/mop.lisp

    r13958 r13959  
    5858          compute-default-initargs
    5959          compute-effective-slot-definition
     60          compute-effective-method
    6061          compute-slots
    6162          finalize-inheritance
Note: See TracChangeset for help on using the changeset viewer.