Changeset 14488


Ignore:
Timestamp:
04/30/13 09:40:51 (9 years ago)
Author:
rschlatte
Message:

add fast writer methods

  • avoid generic function dispatch if there's only one method and it's a standard writer method
File:
1 edited

Legend:

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

    r14486 r14488  
    22752275              (slot-name (std-slot-value slot-definition 'sys:name))
    22762276              (class (car (std-method-specializers method))))
    2277          #'(lambda (arg)
     2277         #'(lambda (instance)
    22782278             ;; TODO: elide this test for low values of SAFETY
    2279              (unless (typep arg class) (no-applicable-method gf (list arg)))
     2279             (unless (typep instance class)
     2280               (no-applicable-method gf (list instance)))
    22802281             ;; hash table lookup for slot position in Layout object via
    22812282             ;; StandardObject.SLOT_VALUE, so should be reasonably fast
    2282              (std-slot-value arg slot-name))))
    2283 
     2283             (std-slot-value instance slot-name))))
     2284      ((and (= (length methods) 1)
     2285            (eq (type-of (car methods)) 'standard-writer-method)
     2286            (eq (type-of (second (std-method-specializers (car methods))))
     2287                'standard-class))
     2288       (let* ((method (first methods))
     2289              (slot-definition (std-slot-value method 'sys::%slot-definition))
     2290              (slot-name (std-slot-value slot-definition 'sys:name))
     2291              (class (car (std-method-specializers method))))
     2292         #'(lambda (new-value instance)
     2293             ;; TODO: elide this test for low values of SAFETY
     2294             (unless (typep instance class)
     2295               (no-applicable-method gf (list new-value instance)))
     2296             ;; hash table lookup for slot position in Layout object via
     2297             ;; StandardObject.SET_SLOT_VALUE, so should be reasonably fast
     2298             (setf (std-slot-value instance slot-name) new-value))))
    22842299      (t
    22852300       (let* ((emf-table (classes-to-emf-table gf))
Note: See TracChangeset for help on using the changeset viewer.