Changeset 5235


Ignore:
Timestamp:
12/20/03 19:06:48 (18 years ago)
Author:
piso
Message:

COMPUTE-APPLICABLE-METHODS-USING-CLASSES

File:
1 edited

Legend:

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

    r5233 r5235  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.53 2003-12-20 18:29:32 piso Exp $
     4;;; $Id: clos.lisp,v 1.54 2003-12-20 19:06:48 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    11731173               gf args classes))))
    11741174
    1175 (defun compute-applicable-methods-using-classes (gf required-classes)
    1176   (sort
    1177    (copy-list
    1178     (remove-if-not #'(lambda (method)
    1179                       (every #'subclassp
    1180                              required-classes
    1181                              (method-specializers method)))
    1182                    (generic-function-methods gf)))
    1183    (if (eq (class-of gf) the-class-standard-gf)
    1184        #'(lambda (m1 m2)
    1185           (std-method-more-specific-p m1 m2 required-classes))
    1186        #'(lambda (m1 m2)
    1187           (method-more-specific-p gf m1 m2 required-classes)))))
    1188 
    11891175(defun sub-specializer-p (c1 c2 c-arg)
    11901176  (find c2 (cdr (memq c1 (class-precedence-list c-arg)))))
     
    11991185        required-classes)
    12001186  nil)
     1187
     1188(defun compute-applicable-methods-using-classes (gf required-classes)
     1189  (let ((methods ()))
     1190    (dolist (method (generic-function-methods gf))
     1191      (when (every #'subclassp required-classes (method-specializers method))
     1192        (push method methods)))
     1193    (sort methods
     1194          (if (eq (class-of gf) the-class-standard-gf)
     1195              #'(lambda (m1 m2)
     1196                 (std-method-more-specific-p m1 m2 required-classes))
     1197              #'(lambda (m1 m2)
     1198                 (method-more-specific-p gf m1 m2 required-classes))))))
    12011199
    12021200(defun primary-method-p (method)
Note: See TracChangeset for help on using the changeset viewer.