The attached (highly experimental) patch seems to improve the performance of normal sends (in the case of a cache hit) by roughly 100% - 150%. The difference between this mere factor of two improvement and the factor of six-through-ten I was seeing earlier is, I speculate, related to object-ref taking a lot of time.

Interestingly, the performance of (send something message) is, with this patch, seemingly roughly en par with the performance of generics captured using generic and invoked using send-generic.

I haven't yet tried running a full racket system with this patch applied. I wonder if it makes a difference to the interactive performance of DrRacket?

Major weaknesses of the approach:

 - overhead on cache miss is unknown
 - not safe-for-space yet (weak boxes are immutable)

The approach should generalize easily to polymorphic inline caches.

Regards,
  Tony
diff --git a/collects/racket/private/class-internal.rkt 
b/collects/racket/private/class-internal.rkt
index d00ef10..0a96cba 100644
--- a/collects/racket/private/class-internal.rkt
+++ b/collects/racket/private/class-internal.rkt
@@ -3734,19 +3734,30 @@
   (let ()
     
     (define (do-method traced? stx form obj name args rest-arg?)
-      (with-syntax ([(sym method receiver)
-                     (generate-temporaries (syntax (1 2 3)))])
+      (with-syntax ([(sym in-object in-class state method receiver)
+                     (generate-temporaries (syntax (1 2 3 4 5 6)))]
+                   [*cached-state*
+                    (syntax-local-lift-expression
+                     (syntax (cons #f #f)))])
         (quasisyntax/loc stx
           (let*-values ([(sym) (quasiquote (unsyntax (localize name)))]
-                        [(method receiver)
-                         (find-method/who '(unsyntax form)
-                                          (unsyntax obj)
-                                          sym)])
+                       [(in-object) (unsyntax obj)]
+                       [(in-class) (and (object? in-object) (object-ref 
in-object))]
+                       [(state) *cached-state*]
+                        [(method)
+                        (if (and in-class (eq? (car state) in-class))
+                            (cdr state)
+                            (let-values ([(m r)
+                                          (find-method/who '(unsyntax form)
+                                                           in-object
+                                                           sym)])
+                              (set! *cached-state* (cons in-class m))
+                              m))])
             (unsyntax
              (make-method-call
               traced?
               stx
-              (syntax/loc stx receiver)
+              (syntax/loc stx in-object)
               (syntax/loc stx method)
               (syntax/loc stx sym)
               args
_________________________________________________
  For list-related administrative tasks:
  http://lists.racket-lang.org/listinfo/dev

Reply via email to