Changeset 14490


Ignore:
Timestamp:
05/02/13 09:14:27 (10 years ago)
Author:
rschlatte
Message:

Eliminate one of our effective method function caches

  • classes-to-emf-table was only ever used for gfs with exactly one argument but more than one method - use the cache in StandardGenericFunction?.java for that case as well
  • also rename %finalize-generic-function to %clear-emf-cache, since that is what it's doing
Location:
trunk/abcl/src/org/armedbear/lisp
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r14485 r14490  
    553553        autoload(PACKAGE_SYS, "%%string=", "StringFunctions");
    554554        autoload(PACKAGE_SYS, "%adjust-array", "adjust_array");
     555        autoload(PACKAGE_SYS, "%clear-emf-cache", "StandardGenericFunction", true);
    555556        autoload(PACKAGE_SYS, "%defpackage", "PackageFunctions");
    556         autoload(PACKAGE_SYS, "%finalize-generic-function", "StandardGenericFunction", true);
    557557        autoload(PACKAGE_SYS, "%get-output-stream-bytes", "ByteArrayOutputStream"); //AS 20090325
    558558        autoload(PACKAGE_SYS, "%get-output-stream-array", "ByteArrayOutputStream");
    … …  
    579579        autoload(PACKAGE_SYS, "%set-function-info", "function_info");
    580580        autoload(PACKAGE_SYS, "%init-eql-specializations", "StandardGenericFunction", true);
    581         autoload(PACKAGE_SYS, "%get-arg-specialization", "StandardGenericFunction", true);
    582581        autoload(PACKAGE_SYS, "%set-symbol-macro", "Primitives");
    583582        autoload(PACKAGE_SYS, "%simple-bit-vector-bit-and", "SimpleBitVector");

  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r14482 r14490  
    832832                              constantlyNil),
    833833           new SlotDefinition(Symbol.DECLARATIONS, NIL, constantlyNil),
    834            new SlotDefinition(Symbol.CLASSES_TO_EMF_TABLE, NIL, constantlyNil),
    835834           new SlotDefinition(Symbol._DOCUMENTATION, NIL, constantlyNil,
    836835                              list(internKeyword("DOCUMENTATION")))));

  • trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java

    r14485 r14490  
    6262    setInstanceSlotValue(Symbol.ARGUMENT_PRECEDENCE_ORDER, NIL);
    6363    setInstanceSlotValue(Symbol.DECLARATIONS, NIL);
    64     setInstanceSlotValue(Symbol.CLASSES_TO_EMF_TABLE, NIL);
    6564    setInstanceSlotValue(Symbol._DOCUMENTATION, NIL);
    6665  }
    6766
    68   void finalizeInternal()
     67  void clearCache()
    6968  {
    7069    cache = null;
    … …  
    115114
    116115
    117   private static final Primitive _FINALIZE_GENERIC_FUNCTION
     116  private static final Primitive _CLEAR_EMF_CACHE
    118117    = new pf__finalize_generic_function();
    119   @DocString(name="%finalize-generic-function",
     118  @DocString(name="%clear-emf-cache",
    120119             args="generic-function")
    121120  private static final class  pf__finalize_generic_function extends Primitive
    … …  
    123122    pf__finalize_generic_function()
    124123    {
    125       super("%finalize-generic-function", PACKAGE_SYS, true,
     124      super("%clear-emf-cache", PACKAGE_SYS, true,
    126125            "generic-function");
    127126    }
    … …  
    130129    {
    131130      final StandardGenericFunction gf = checkStandardGenericFunction(arg);
    132       gf.finalizeInternal();       
     131      gf.clearCache();       
    133132      return T;
    134133    }
    … …  
    265264  }
    266265
    267   private static final Primitive _GET_ARG_SPECIALIZATION
    268     = new pf__get_arg_specialization();
    269   @DocString(name="%get-arg-specialization",
    270              args="generic-function arg")
    271   private static final class pf__get_arg_specialization extends Primitive
    272   {
    273     pf__get_arg_specialization()
    274     {
    275       super("%get-arg-specialization", PACKAGE_SYS, true, "generic-function arg");
    276     }
    277     @Override
    278     public LispObject execute(LispObject first, LispObject second)
    279     {
    280       final StandardGenericFunction gf = checkStandardGenericFunction(first);
    281       return gf.getArgSpecialization(second);
    282     }
    283   };
    284 
    285266  private static class CacheEntry
    286267  {

  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r14482 r14490  
    31573157  public static final Symbol CAUSE =
    31583158    PACKAGE_SYS.addInternalSymbol("CAUSE");
    3159   public static final Symbol CLASSES_TO_EMF_TABLE =
    3160     PACKAGE_SYS.addInternalSymbol("CLASSES-TO-EMF-TABLE");
    31613159  public static final Symbol COMMA_MACRO =
    31623160    PACKAGE_SYS.addInternalSymbol("COMMA-MACRO");

  • trunk/abcl/src/org/armedbear/lisp/autoloads-gen.lisp

    r14459 r14490  
    4646
    4747(IN-PACKAGE :MOP)
    48 (DOLIST (SYSTEM::FS (QUOTE ((("clos") CLASS-SLOTS CLASS-DIRECT-SLOTS CLASS-LAYOUT CLASS-DIRECT-SUPERCLASSES CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-METHODS CLASS-PRECEDENCE-LIST CLASS-FINALIZED-P CLASS-DEFAULT-INITARGS CLASS-DIRECT-DEFAULT-INITARGS ADD-DIRECT-SUBCLASS REMOVE-DIRECT-SUBCLASS FIXUP-STANDARD-CLASS-HIERARCHY MAP-DEPENDENTS MAPAPPEND MAPPLIST FUNCALLABLE-STANDARD-INSTANCE-ACCESS CANONICALIZE-DIRECT-SLOTS CANONICALIZE-DIRECT-SLOT MAYBE-NOTE-NAME-DEFINED CANONICALIZE-DEFCLASS-OPTIONS CANONICALIZE-DEFCLASS-OPTION MAKE-INITFUNCTION SLOT-DEFINITION-ALLOCATION SLOT-DEFINITION-INITARGS SLOT-DEFINITION-INITFORM SLOT-DEFINITION-INITFUNCTION SLOT-DEFINITION-NAME SLOT-DEFINITION-READERS SLOT-DEFINITION-WRITERS SLOT-DEFINITION-ALLOCATION-CLASS SLOT-DEFINITION-LOCATION SLOT-DEFINITION-TYPE SLOT-DEFINITION-DOCUMENTATION INIT-SLOT-DEFINITION DIRECT-SLOT-DEFINITION-CLASS MAKE-DIRECT-SLOT-DEFINITION EFFECTIVE-SLOT-DEFINITION-CLASS MAKE-EFFECTIVE-SLOT-DEFINITION COMPUTE-DEFAULT-INITARGS STD-COMPUTE-DEFAULT-INITARGS STD-FINALIZE-INHERITANCE FINALIZE-INHERITANCE STD-COMPUTE-CLASS-PRECEDENCE-LIST TOPOLOGICAL-SORT STD-TIE-BREAKER-RULE COLLECT-SUPERCLASSES* LOCAL-PRECEDENCE-ORDERING STD-COMPUTE-SLOTS STD-COMPUTE-EFFECTIVE-SLOT-DEFINITION FIND-SLOT-DEFINITION SLOT-LOCATION INSTANCE-SLOT-LOCATION %SET-SLOT-VALUE STD-SLOT-MAKUNBOUND STD-SLOT-EXISTS-P INSTANCE-SLOT-P STD-ALLOCATE-INSTANCE ALLOCATE-FUNCALLABLE-INSTANCE CLASS-PROTOTYPE MAYBE-FINALIZE-CLASS-SUBTREE MAKE-INSTANCE-STANDARD-CLASS STD-AFTER-INITIALIZATION-FOR-CLASSES EXPAND-LONG-DEFCOMBIN %MAKE-LONG-METHOD-COMBINATION METHOD-COMBINATION-NAME METHOD-COMBINATION-DOCUMENTATION SHORT-METHOD-COMBINATION-OPERATOR SHORT-METHOD-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT LONG-METHOD-COMBINATION-LAMBDA-LIST LONG-METHOD-COMBINATION-METHOD-GROUP-SPECS LONG-METHOD-COMBINATION-ARGS-LAMBDA-LIST LONG-METHOD-COMBINATION-GENERIC-FUNCTION-SYMBOL LONG-METHOD-COMBINATION-FUNCTION LONG-METHOD-COMBINATION-ARGUMENTS LONG-METHOD-COMBINATION-DECLARATIONS LONG-METHOD-COMBINATION-FORMS EXPAND-SHORT-DEFCOMBIN METHOD-GROUP-P CHECK-VARIABLE-NAME CANONICALIZE-METHOD-GROUP-SPEC EXTRACT-REQUIRED-PART EXTRACT-SPECIFIED-PART EXTRACT-OPTIONAL-PART PARSE-DEFINE-METHOD-COMBINATION-ARGS-LAMBDA-LIST WRAP-WITH-CALL-METHOD-MACRO ASSERT-UNAMBIGUOUS-METHOD-SORTING METHOD-COMBINATION-TYPE-LAMBDA-WITH-ARGS-EMF METHOD-COMBINATION-TYPE-LAMBDA DECLARATIONP LONG-FORM-METHOD-COMBINATION-ARGS DEFINE-LONG-FORM-METHOD-COMBINATION STD-FIND-METHOD-COMBINATION FIND-METHOD-COMBINATION INTERN-EQL-SPECIALIZER EQL-SPECIALIZER-OBJECT STD-METHOD-FUNCTION STD-METHOD-GENERIC-FUNCTION STD-METHOD-SPECIALIZERS STD-METHOD-QUALIFIERS STD-ACCESSOR-METHOD-SLOT-DEFINITION STD-METHOD-FAST-FUNCTION STD-FUNCTION-KEYWORDS METHOD-GENERIC-FUNCTION METHOD-FUNCTION METHOD-SPECIALIZERS GENERIC-FUNCTION-NAME GENERIC-FUNCTION-LAMBDA-LIST GENERIC-FUNCTION-METHODS GENERIC-FUNCTION-METHOD-CLASS GENERIC-FUNCTION-METHOD-COMBINATION GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER CLASSES-TO-EMF-TABLE METHOD-DOCUMENTATION CANONICALIZE-DEFGENERIC-OPTIONS CANONICALIZE-DEFGENERIC-OPTION ARGUMENT-PRECEDENCE-ORDER-INDICES FIND-GENERIC-FUNCTION LAMBDA-LISTS-CONGRUENT-P %DEFGENERIC COLLECT-EQL-SPECIALIZER-OBJECTS FINALIZE-STANDARD-GENERIC-FUNCTION MAKE-INSTANCE-STANDARD-GENERIC-FUNCTION CANONICALIZE-SPECIALIZERS CANONICALIZE-SPECIALIZER PARSE-DEFMETHOD REQUIRED-PORTION EXTRACT-LAMBDA-LIST EXTRACT-SPECIALIZER-NAMES GET-KEYWORD-FROM-ARG ANALYZE-LAMBDA-LIST CHECK-METHOD-LAMBDA-LIST CHECK-ARGUMENT-PRECEDENCE-ORDER ENSURE-METHOD MAKE-INSTANCE-STANDARD-METHOD ADD-DIRECT-METHOD REMOVE-DIRECT-METHOD STD-ADD-METHOD STD-REMOVE-METHOD %FIND-METHOD FAST-CALLABLE-P SLOW-READER-LOOKUP STD-COMPUTE-DISCRIMINATING-FUNCTION SORT-METHODS METHOD-APPLICABLE-P STD-COMPUTE-APPLICABLE-METHODS METHOD-APPLICABLE-USING-CLASSES-P CHECK-APPLICABLE-METHOD-KEYWORD-ARGS COMPUTE-APPLICABLE-KEYWORDS WRAP-EMFUN-FOR-KEYWORD-ARGS-CHECK SLOW-METHOD-LOOKUP SLOW-METHOD-LOOKUP-1 SUB-SPECIALIZER-P STD-METHOD-MORE-SPECIFIC-P PRIMARY-METHOD-P BEFORE-METHOD-P AFTER-METHOD-P AROUND-METHOD-P PROCESS-NEXT-METHOD-LIST STD-COMPUTE-EFFECTIVE-METHOD GENERATE-EMF-LAMBDA COMPUTE-PRIMARY-EMFUN WALK-FORM COMPUTE-METHOD-FUNCTION COMPUTE-METHOD-FAST-FUNCTION MAKE-METHOD-LAMBDA ALLOW-OTHER-KEYS MAKE-INSTANCE-STANDARD-ACCESSOR-METHOD ADD-READER-METHOD ADD-WRITER-METHOD CHECK-DUPLICATE-SLOTS CHECK-DUPLICATE-DEFAULT-INITARGS CANONICALIZE-DIRECT-SUPERCLASSES ENSURE-CLASS ENSURE-CLASS-USING-CLASS READER-METHOD-CLASS WRITER-METHOD-CLASS COMPUTE-APPLICABLE-METHODS-USING-CLASSES SLOT-VALUE-USING-CLASS SLOT-EXISTS-P-USING-CLASS SLOT-BOUNDP-USING-CLASS SLOT-MAKUNBOUND-USING-CLASS CALCULATE-ALLOWABLE-INITARGS CHECK-INITARGS MERGE-INITARGS-SETS EXTRACT-LAMBDA-LIST-KEYWORDS AUGMENT-INITARGS-WITH-DEFAULTS STD-SHARED-INITIALIZE COMPUTE-SLOTS COMPUTE-EFFECTIVE-SLOT-DEFINITION COMPUTE-DISCRIMINATING-FUNCTION METHOD-MORE-SPECIFIC-P COMPUTE-EFFECTIVE-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS SPECIALIZER-DIRECT-METHODS ADD-DEPENDENT REMOVE-DEPENDENT UPDATE-DEPENDENT ENSURE-GENERIC-FUNCTION-USING-CLASS %METHOD-GENERIC-FUNCTION %METHOD-FUNCTION)))) (FUNCALL (FUNCTION AUTOLOAD) (CDR SYSTEM::FS) (CAR (CAR SYSTEM::FS))))
     48(DOLIST (SYSTEM::FS (QUOTE ((("clos") CLASS-SLOTS CLASS-DIRECT-SLOTS CLASS-LAYOUT CLASS-DIRECT-SUPERCLASSES CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-METHODS CLASS-PRECEDENCE-LIST CLASS-FINALIZED-P CLASS-DEFAULT-INITARGS CLASS-DIRECT-DEFAULT-INITARGS ADD-DIRECT-SUBCLASS REMOVE-DIRECT-SUBCLASS FIXUP-STANDARD-CLASS-HIERARCHY MAP-DEPENDENTS MAPAPPEND MAPPLIST FUNCALLABLE-STANDARD-INSTANCE-ACCESS CANONICALIZE-DIRECT-SLOTS CANONICALIZE-DIRECT-SLOT MAYBE-NOTE-NAME-DEFINED CANONICALIZE-DEFCLASS-OPTIONS CANONICALIZE-DEFCLASS-OPTION MAKE-INITFUNCTION SLOT-DEFINITION-ALLOCATION SLOT-DEFINITION-INITARGS SLOT-DEFINITION-INITFORM SLOT-DEFINITION-INITFUNCTION SLOT-DEFINITION-NAME SLOT-DEFINITION-READERS SLOT-DEFINITION-WRITERS SLOT-DEFINITION-ALLOCATION-CLASS SLOT-DEFINITION-LOCATION SLOT-DEFINITION-TYPE SLOT-DEFINITION-DOCUMENTATION INIT-SLOT-DEFINITION DIRECT-SLOT-DEFINITION-CLASS MAKE-DIRECT-SLOT-DEFINITION EFFECTIVE-SLOT-DEFINITION-CLASS MAKE-EFFECTIVE-SLOT-DEFINITION COMPUTE-DEFAULT-INITARGS STD-COMPUTE-DEFAULT-INITARGS STD-FINALIZE-INHERITANCE FINALIZE-INHERITANCE STD-COMPUTE-CLASS-PRECEDENCE-LIST TOPOLOGICAL-SORT STD-TIE-BREAKER-RULE COLLECT-SUPERCLASSES* LOCAL-PRECEDENCE-ORDERING STD-COMPUTE-SLOTS STD-COMPUTE-EFFECTIVE-SLOT-DEFINITION FIND-SLOT-DEFINITION SLOT-LOCATION INSTANCE-SLOT-LOCATION %SET-SLOT-VALUE STD-SLOT-MAKUNBOUND STD-SLOT-EXISTS-P INSTANCE-SLOT-P STD-ALLOCATE-INSTANCE ALLOCATE-FUNCALLABLE-INSTANCE CLASS-PROTOTYPE MAYBE-FINALIZE-CLASS-SUBTREE MAKE-INSTANCE-STANDARD-CLASS STD-AFTER-INITIALIZATION-FOR-CLASSES EXPAND-LONG-DEFCOMBIN %MAKE-LONG-METHOD-COMBINATION METHOD-COMBINATION-NAME METHOD-COMBINATION-DOCUMENTATION SHORT-METHOD-COMBINATION-OPERATOR SHORT-METHOD-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT LONG-METHOD-COMBINATION-LAMBDA-LIST LONG-METHOD-COMBINATION-METHOD-GROUP-SPECS LONG-METHOD-COMBINATION-ARGS-LAMBDA-LIST LONG-METHOD-COMBINATION-GENERIC-FUNCTION-SYMBOL LONG-METHOD-COMBINATION-FUNCTION LONG-METHOD-COMBINATION-ARGUMENTS LONG-METHOD-COMBINATION-DECLARATIONS LONG-METHOD-COMBINATION-FORMS EXPAND-SHORT-DEFCOMBIN METHOD-GROUP-P CHECK-VARIABLE-NAME CANONICALIZE-METHOD-GROUP-SPEC EXTRACT-REQUIRED-PART EXTRACT-SPECIFIED-PART EXTRACT-OPTIONAL-PART PARSE-DEFINE-METHOD-COMBINATION-ARGS-LAMBDA-LIST WRAP-WITH-CALL-METHOD-MACRO ASSERT-UNAMBIGUOUS-METHOD-SORTING METHOD-COMBINATION-TYPE-LAMBDA-WITH-ARGS-EMF METHOD-COMBINATION-TYPE-LAMBDA DECLARATIONP LONG-FORM-METHOD-COMBINATION-ARGS DEFINE-LONG-FORM-METHOD-COMBINATION STD-FIND-METHOD-COMBINATION FIND-METHOD-COMBINATION INTERN-EQL-SPECIALIZER EQL-SPECIALIZER-OBJECT STD-METHOD-FUNCTION STD-METHOD-GENERIC-FUNCTION STD-METHOD-SPECIALIZERS STD-METHOD-QUALIFIERS STD-ACCESSOR-METHOD-SLOT-DEFINITION STD-METHOD-FAST-FUNCTION STD-FUNCTION-KEYWORDS METHOD-GENERIC-FUNCTION METHOD-FUNCTION METHOD-SPECIALIZERS GENERIC-FUNCTION-NAME GENERIC-FUNCTION-LAMBDA-LIST GENERIC-FUNCTION-METHODS GENERIC-FUNCTION-METHOD-CLASS GENERIC-FUNCTION-METHOD-COMBINATION GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER METHOD-DOCUMENTATION CANONICALIZE-DEFGENERIC-OPTIONS CANONICALIZE-DEFGENERIC-OPTION ARGUMENT-PRECEDENCE-ORDER-INDICES FIND-GENERIC-FUNCTION LAMBDA-LISTS-CONGRUENT-P %DEFGENERIC COLLECT-EQL-SPECIALIZER-OBJECTS FINALIZE-STANDARD-GENERIC-FUNCTION MAKE-INSTANCE-STANDARD-GENERIC-FUNCTION CANONICALIZE-SPECIALIZERS CANONICALIZE-SPECIALIZER PARSE-DEFMETHOD REQUIRED-PORTION EXTRACT-LAMBDA-LIST EXTRACT-SPECIALIZER-NAMES GET-KEYWORD-FROM-ARG ANALYZE-LAMBDA-LIST CHECK-METHOD-LAMBDA-LIST CHECK-ARGUMENT-PRECEDENCE-ORDER ENSURE-METHOD MAKE-INSTANCE-STANDARD-METHOD ADD-DIRECT-METHOD REMOVE-DIRECT-METHOD STD-ADD-METHOD STD-REMOVE-METHOD %FIND-METHOD FAST-CALLABLE-P SLOW-READER-LOOKUP STD-COMPUTE-DISCRIMINATING-FUNCTION SORT-METHODS METHOD-APPLICABLE-P STD-COMPUTE-APPLICABLE-METHODS METHOD-APPLICABLE-USING-CLASSES-P CHECK-APPLICABLE-METHOD-KEYWORD-ARGS COMPUTE-APPLICABLE-KEYWORDS WRAP-EMFUN-FOR-KEYWORD-ARGS-CHECK SLOW-METHOD-LOOKUP SLOW-METHOD-LOOKUP-1 SUB-SPECIALIZER-P STD-METHOD-MORE-SPECIFIC-P PRIMARY-METHOD-P BEFORE-METHOD-P AFTER-METHOD-P AROUND-METHOD-P PROCESS-NEXT-METHOD-LIST STD-COMPUTE-EFFECTIVE-METHOD GENERATE-EMF-LAMBDA COMPUTE-PRIMARY-EMFUN WALK-FORM COMPUTE-METHOD-FUNCTION COMPUTE-METHOD-FAST-FUNCTION MAKE-METHOD-LAMBDA ALLOW-OTHER-KEYS MAKE-INSTANCE-STANDARD-ACCESSOR-METHOD ADD-READER-METHOD ADD-WRITER-METHOD CHECK-DUPLICATE-SLOTS CHECK-DUPLICATE-DEFAULT-INITARGS CANONICALIZE-DIRECT-SUPERCLASSES ENSURE-CLASS ENSURE-CLASS-USING-CLASS READER-METHOD-CLASS WRITER-METHOD-CLASS COMPUTE-APPLICABLE-METHODS-USING-CLASSES SLOT-VALUE-USING-CLASS SLOT-EXISTS-P-USING-CLASS SLOT-BOUNDP-USING-CLASS SLOT-MAKUNBOUND-USING-CLASS CALCULATE-ALLOWABLE-INITARGS CHECK-INITARGS MERGE-INITARGS-SETS EXTRACT-LAMBDA-LIST-KEYWORDS AUGMENT-INITARGS-WITH-DEFAULTS STD-SHARED-INITIALIZE COMPUTE-SLOTS COMPUTE-EFFECTIVE-SLOT-DEFINITION COMPUTE-DISCRIMINATING-FUNCTION METHOD-MORE-SPECIFIC-P COMPUTE-EFFECTIVE-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS SPECIALIZER-DIRECT-METHODS ADD-DEPENDENT REMOVE-DEPENDENT UPDATE-DEPENDENT ENSURE-GENERIC-FUNCTION-USING-CLASS %METHOD-GENERIC-FUNCTION %METHOD-FUNCTION)))) (FUNCALL (FUNCTION AUTOLOAD) (CDR SYSTEM::FS) (CAR (CAR SYSTEM::FS))))
    4949
    5050;; MACROS

  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r14488 r14490  
    16131613  (std-slot-value gf 'sys::optional-args))
    16141614
    1615 (declaim (ftype (function * t) classes-to-emf-table))
    1616 (defun classes-to-emf-table (gf)
    1617   (std-slot-value gf 'sys::classes-to-emf-table))
    1618 
    1619 (defun (setf classes-to-emf-table) (new-value gf)
    1620   (setf (std-slot-value gf 'sys::classes-to-emf-table) new-value))
    1621 
    16221615(defun (setf method-lambda-list) (new-value method)
    16231616  (setf (std-slot-value method 'sys::lambda-list) new-value))
    … …  
    18271820
    18281821(defun finalize-standard-generic-function (gf)
    1829   (%finalize-generic-function gf)
    1830   (if (classes-to-emf-table gf)
    1831       (clrhash (classes-to-emf-table gf))
    1832       (setf (classes-to-emf-table gf) (make-hash-table :test #'equal)))
     1822  (%clear-emf-cache gf)
    18331823  (%init-eql-specializations gf (collect-eql-specializer-objects gf))
    18341824  (set-funcallable-instance-function
    … …  
    18661856    (setf (std-slot-value gf 'sys::declarations) declarations)
    18671857    (setf (std-slot-value gf 'sys::%documentation) documentation)
    1868     (setf (std-slot-value gf 'sys::classes-to-emf-table) nil)
    18691858    (let* ((plist (analyze-lambda-list (generic-function-lambda-list gf)))
    18701859           (required-args (getf plist ':required-args)))
    … …  
    22582247                           '(&rest &optional &key &allow-other-keys &aux)))))
    22592248
    2260 (declaim (ftype (function * t) slow-method-lookup-1))
    2261 
    22622249(defun std-compute-discriminating-function (gf)
    22632250  ;; In this function, we know that gf is of class
    … …  
    22982285             (setf (std-slot-value instance slot-name) new-value))))
    22992286      (t
    2300        (let* ((emf-table (classes-to-emf-table gf))
    2301               (number-required (length (generic-function-required-arguments gf)))
     2287       (let* ((number-required (length (generic-function-required-arguments gf)))
    23022288              (lambda-list (generic-function-lambda-list gf))
    23032289              (exact (null (intersection lambda-list
    … …  
    23392325                   #'(lambda (arg)
    23402326                       (declare (optimize speed))
    2341                        (let* ((specialization
    2342                                 (%get-arg-specialization gf arg))
    2343                               (emfun (or (gethash1 specialization
    2344                                                    emf-table)
    2345                                          (slow-method-lookup-1
    2346                                           gf arg specialization))))
     2327                       (let* ((args (list arg))
     2328                              (emfun (get-cached-emf gf args)))
    23472329                         (if emfun
    2348                              (funcall emfun (list arg))
    2349                              (apply #'no-applicable-method gf (list arg))))))))
     2330                             (funcall emfun args)
     2331                             (slow-method-lookup gf args)))))))
    23502332               ((= number-required 2)
    23512333                #'(lambda (arg1 arg2)
    … …  
    23762358                          (funcall emfun args)
    23772359                          (slow-method-lookup gf args))))))
    2378              ;;           (let ((non-key-args (+ number-required
    2379              ;;                                  (length (generic-function-optional-arguments gf))))))
    23802360             #'(lambda (&rest args)
    23812361                 (declare (optimize speed))
    … …  
    25262506          (funcall emfun args))
    25272507        (apply #'no-applicable-method gf args))))
    2528 
    2529 (defun slow-method-lookup-1 (gf arg arg-specialization)
    2530   (let ((applicable-methods
    2531           (if (eq (class-of gf) +the-standard-generic-function-class+)
    2532               (std-compute-applicable-methods gf (list arg))
    2533               (or (compute-applicable-methods-using-classes gf (list (class-of arg)))
    2534                   (compute-applicable-methods gf (list arg))))))
    2535     (if applicable-methods
    2536         (let ((emfun (funcall (if (eq (class-of gf)
    2537                                       +the-standard-generic-function-class+)
    2538                                   #'std-compute-effective-method
    2539                                   #'compute-effective-method)
    2540                               gf (generic-function-method-combination gf)
    2541                               applicable-methods)))
    2542           (when emfun
    2543             (setf (gethash arg-specialization (classes-to-emf-table gf)) emfun))
    2544           emfun))))
    25452508
    25462509(defun sub-specializer-p (c1 c2 c-arg)
Note: See TracChangeset for help on using the changeset viewer.